(04/11/2020, 17:21)berduş yazdı: tarih alanı verileri hangi sütundan alıyor?Yukarıdaki kodu alttaki gibi değiştiriseniz hem kod kısalır hemde toplam tutar sayısal olur abey.
bu arada aşağıdaki kodu dener misiniz?
Sub Aktar() Dim syfForum As Worksheet Dim i As Long, son As Long, sonVer As Long Set syfForum = ThisWorkbook.Sheets("Form") With ThisWorkbook.Sheets("Veri") syfForum.Range("A2:F" & Rows.Count).ClearContents Application.ScreenUpdating = False Dim Sql As String Dim ADO_CN As Object Dim ADO_RS As Object Set ADO_CN = CreateObject("Adodb.Connection") Set ADO_RS = CreateObject("adodb.recordset") SQL = "SELECT F6, format(cdate(F19),'dd.mm.yyyy') & ' ' & F7, F2 & '-' & F3, F12, F4 " SQL = Sql & vbCrLf SQL = Sql & "FROM [Veri$" & "] where F13='Yabancı Araç Plakasına' ;" ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & _ ";extended properties=""excel 8.0;hdr=no;imex=1""" ADO_CN.Open ADO_RS.Open SQL, ADO_CN, 3, 1 ' ' Eğer Hiç Kayıt Yoksa If ADO_RS.RecordCount = 0 Then ADO_RS.Close ADO_CN.Close Set ADO_RS = Nothing Set ADO_CN = Nothing MsgBox "Kayıt Bulunamadı.", vbCritical, "Veri Yok" Exit Sub End If ADO_RS.movelast ADO_RS.movefirst Debug.Print ADO_RS.RecordCount syfForum.Range("a2").CopyFromRecordset ADO_RS ADO_RS.Close ADO_CN.Close Set ADO_RS = Nothing Set ADO_CN = Nothing ' MsgBox "Akrarma Tamam...", vbInformation, "Aktarma" Application.ScreenUpdating = True End With GoTo son2 son: MsgBox "Akrarma Basarisiz...", vbExclamation, "Aktarma" son2: Set syfForum = Nothing End Sub
SQL = "SELECT F6, format(cdate(F19),'dd.mm.yyyy') & ' ' & F7, F2 & '-' & F3, F12, F4 " SQL = Sql & vbCrLf SQL = Sql & "FROM [Veri$" & "] where F13='Yabancı Araç Plakasına' ;"
Kod bendede çalıştı.
SQL = "SELECT F6, format(cdate(F19),'dd.mm.yyyy') & ' ' & F7, F2 & '-' & F3, F12, cdbl(F4) "
SQL = Sql & "FROM [Veri$] where F13='Yabancı Araç Plakasına' ;"