1. Alttaki koddaki Sql = "SELECT [Baslik 1] FROM [Sayfa2$A1:A] where [Baslik 1]>0" yeri pasif yaptım onu denerseniz satır 100bin olsada 65336 olarak veri getiriyor en fazla.
2.hdr=yes olunca baslıklarda boşluk varsa mesela Baslık 1 gibi ozaman [] kullanılmalı yoksa Baslık1 gibi olursa [] bunlara gerek yok olursatabii daha iyi our diyenlerde olmuştu.
Basit bir örnek hazırladım hız karşılaştırması için.
Sub Aktar()
Dim Sql As String
Dim ADO_CN As Object
Dim ADO_RS As Object
t = TimeValue(Now)
ThisWorkbook.Sheets("Sayfa1").Range("A2:A" & Rows.Count).ClearContents
Set ADO_CN = CreateObject("Adodb.Connection")
Set ADO_RS = CreateObject("adodb.recordset")
' Sql = "SELECT [Baslik 1] FROM [Sayfa2$A1:A] where [Baslik 1]>0"
Sql = "SELECT [Baslik 1] FROM [Sayfa2$] where [Baslik 1]>0"
ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & _
";extended properties=""excel 8.0;hdr=yes;imex=1"""
ADO_CN.Open
ADO_RS.Open SQL, ADO_CN, 1, 1
ThisWorkbook.Sheets("Sayfa1").Range("a2").CopyFromRecordset ADO_RS
ADO_RS.Close
ADO_CN.Close
Set ADO_RS = Nothing
Set ADO_CN = Nothing
MsgBox CDate(TimeValue(Now) - t), vbInformation
End Sub
Sub Aktar2() 'dizi
Dim arr(), i As Long, dizi(), say As Long
t = TimeValue(Now)
ReDim arr(1 To 100000, 1 To 1)
ThisWorkbook.Sheets("Sayfa1").Range("B2:B100000").Value = ""
dizi = ThisWorkbook.Sheets("Sayfa2").Range("A2:A100000").Value
For i = LBound(dizi) To UBound(dizi)
If dizi(i, 1) > 0 Then
say = say + 1
arr(say, 1) = i
End If
Next
ThisWorkbook.Sheets("Sayfa1").Range("B2:B100000").Value = arr
MsgBox CDate(TimeValue(Now) - t), vbInformation
Erase dizi: Erase arr
End Sub
