düşey ara vba çok yavaş

[zamenya]

Sayın hocalarım düşeyara işlemini aşagıdaki komut yaptırıyorum ama çok yavaş çalışıyor 15 dk gibi ,daha hızlı birkod varmı yada modül kodu direk veriyi girdiğimde karşılığını bulacak



private Sub al1_Click()
Dim hcr As Range, s2 As Worksheet, k As Range
Sheets("DATA").Select
Set s2 = Sheets("VERİ")
Application.ScreenUpdating = False
For Each hcr In Range("D2" & Cells(65536, "D").End(xlUp).Row)
Set k = s2.Range("B:B").Find(hcr.Value, , xlValues, xlWhole)
If Not k Is Nothing Then
hcr.Offset(0, 1).Value = k.Offset(0, 1).Value
hcr.Offset(0, 2).Value = k.Offset(0, 2).Value
hcr.Offset(0, 3).Value = k.Offset(0, 7).Value
hcr.Offset(0, 4).Value = k.Offset(0, 9).Value
hcr.Offset(0, 5).Value = k.Offset(0, 10).Value



End If
Next hcr
Set s2 = Nothing
Set k = Nothing
Application.ScreenUpdating = True
MsgBox "Hesaplama İşlemi Tamamdır.."
End Sub

 

[zamenya]

sayın hocalarım yukardaki kodu nasıl hızlandırabilirm yada başka bir çzöümü varmı

 

[accilisse]

dosya eklerseniz daha iyiolur

 

[zamenya]

düşey ara vba

sayın accilisse dosyaık ekledim düşey ara işlemini hesapla1-2-3 butonlarıyla yapıyorum ama veri çoğaldığında çok yavaşlalıyor

 

[zamenya]

Sayın hocalarım lütfen yardım

 

[zamenya]

Evren hocam lütfen yardım

 

[zamenya]

Hocalarım lütfen yardım vba daki düşey ara kodu nasıl hızlandırabilirm

 

[hsayar]

ADODB yöntemini araştırınız...

 

[zamenya]

sayın hsayar adobb araştırdım ama uygulayamıyorum

 

[HKLSZ]

selam,

Sheets("DATA").Select
Dim son As Long
son = Sheets("DATA").[a65536].End(3).Row

 

[zamenya]

sayın hklsz verdiğiniz kod için teşekkürler ama kodu uyarlayamadım ve karşılığı olmayanlara veri yok diye yazdırma imkanı varmı