ErdalÖzdemir
Altın Üye
- Katılım
- 12 Ağustos 2022
- Mesajlar
- 91
- Excel Vers. ve Dili
- 2013 TÜRKÇE
- Altın Üyelik Bitiş Tarihi
- 21-09-2025
Merhaba arkadaşlar,
Kurum Kodu, iki tabloda da eşit ise istenilen verilerin ilgili Kurum kodunun karşısına getirerek kurum bilgilerini güncelliyorum.
Bunu da ADO kullanarak yapıyorum. Fakat çok yavaş çalışıyor. Asıl verilerin çekildiği dosya 60 bin satır aralığında . 60 bin satırın karşısına veriler getiriliyor.
Bu verileri daha hızlı çekmek için ne yapılabilir. Bu konuda uzman hocalarımızın yardımlarını bekliyorum.
Verileri çektiğim kod;
Kurum Kodu, iki tabloda da eşit ise istenilen verilerin ilgili Kurum kodunun karşısına getirerek kurum bilgilerini güncelliyorum.
Bunu da ADO kullanarak yapıyorum. Fakat çok yavaş çalışıyor. Asıl verilerin çekildiği dosya 60 bin satır aralığında . 60 bin satırın karşısına veriler getiriliyor.
Bu verileri daha hızlı çekmek için ne yapılabilir. Bu konuda uzman hocalarımızın yardımlarını bekliyorum.
Verileri çektiğim kod;
Kod:
Sub KURUM_BİLGİLERİNİ_GETİR()
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Dim sql As String, rg As Range
Dim yol As String
Set con = New ADODB.Connection
Set rs = New ADODB.Recordset
yol = "D:\1- BELGELERİM\\6- VERİ TABLOLARI\\KURUM_BİLGİLERİ.xlsb"
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & yol & ";extended properties=""Excel 12.0;hdr=yes"""
'MsgBox con.State
Dim ws As Worksheet
Set ws = Sayfa1
sql = "select [KURUM_KODU],[İLÇE],[GENEL_MÜDÜRLÜK],[KURUM_TÜRÜ],[KURUM_ADI]" _
& "from [KURUM İLETİSİM BİLGİLERİ$]" _
& "Group By[KURUM_KODU],[İLÇE],[GENEL_MÜDÜRLÜK],[KURUM_TÜRÜ],[KURUM_ADI]"
Set rs = con.Execute(sql)
On Error Resume Next
Dim Son As Long
Son = ws.Cells(Rows.Count, 1).End(xlUp).Row
'ws.Range("C2" & " :" & "F2:F" & Son).ClearContents
Dim dizi As Variant
Dim i As Long
Set rg = ws.Range("A2").CurrentRegion
dizi = rg
rs.MoveFirst
Do Until rs.EOF
For i = 2 To UBound(dizi)
If dizi(i, 1) = rs(0) Then
ws.Cells(i, "C") = rs(1) ' İLÇE
ws.Cells(i, "D") = rs(2) ' GENEL_MÜDÜRLÜK
ws.Cells(i, "E") = rs(3) 'KURUM_TÜRÜ
ws.Cells(i, "F") = rs(4) 'OKUL_ADI
End If
Next i
rs.MoveNext
Loop
rs.Close: con.Close
sql = vbNullString: Set rs = Nothing: Set con = Nothing
MsgBox ("İstenilen veriler çekildi")
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Son düzenleme: