hızlı ara

[oydemir]

Düşey ara için kullandığım kod ama 5000 satır olunca uzun sürüyor daha hızlı
olabilmesi için yardımcı olabilirimsiniz




Sub Ara_edinme()
Application.ScreenUpdating = False

Dim S1 As Worksheet
Dim S2 As Worksheet
Dim Bul As Range

Set S1 = Sheets("veri")
Set S2 = Sheets("Hisse")

Son = Cells(Rows.Count, "K").End(3).Row ' ARANACAK SON SATIR

S1.Range("AE2:AE" & S1.Rows.Count).ClearContents

For i = 2 To Son
If S1.Cells(i, "K") <> "" Then 'ARANACAK SUTUN
Set Bul = S2.Range("b:b").Find(S1.Cells(i, "K"), , , xlWhole) 'ARANACAK KOLON
If Not Bul Is Nothing Then
S1.Cells(i, "AE") = Application.VLookup(S1.Cells(i, "K"), S2.Range("A:M"), 12, 0)
End If
End If
Next i

Application.ScreenUpdating = True

End Sub

 

[ÖmerBey]

Merhaba,
Deneyiniz...

Sub Ara_edinme()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim S1 As Worksheet
Dim S2 As Worksheet
Dim Bul As Range

Set S1 = Sheets("veri")
Set S2 = Sheets("Hisse")

son = Cells(Rows.Count, "K").End(3).Row ' ARANACAK SON SATIR
S1.Range("AE2:AE" & S1.Rows.Count).ClearContents
dz = S1.Range("AE1:AE" & son).Value
For i = 2 To son
If S1.Cells(i, "K") <> "" Then 'ARANACAK SUTUN
Set Bul = S2.Range("b:b").Find(S1.Cells(i, "K"), , , xlWhole) 'ARANACAK KOLON
If Not Bul Is Nothing Then
dz(i, 1) = Application.VLookup(S1.Cells(i, "K"), S2.Range("A:M"), 12, 0)
End If
End If
Next i

S1.Range("AE1:AE" & son).Value = dz

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[Zeki Gürsoy]

5000 defa 1 milyon satır üzerinde VLOOKUP yapmak...

İlk olarak VLOOKUP aralığını kısaltmanın yolunu arayın.
.

 

[Necdet]

Merhaba,
Link'i inceleyiniz.

 

[oydemir]

teşekkürler 3 dakika sürüyordu sayenizde 1.5 dakikaya düştü.
Elinize sağlık