DÜŞEYARA formülü yerine makro

serkans

Altın Üye
Katılım
18 Ekim 2004
Mesajlar
171
Excel Vers. ve Dili
Office LTSC Pro Plus 21 64 Bit
Altın Üyelik Bitiş Tarihi
21-07-2028
Merhaba

Ekteki dosyada Adisyon Hareketleri Raporu sekmesindeki AN:AQ sütunlarına, Veri Yeni sekmesinden düşey ara ile veri getirtiyorum.

Her gün satışları ekliyorum ve böylece dosya büyüdükçe maalesef formül yavaşlıyor. Bunu makro ile yapmama yardımcı olabilir misiniz rica etsem.
 

Ekli dosyalar

mozdem

Altın Üye
Katılım
11 Kasım 2005
Mesajlar
453
Excel Vers. ve Dili
Windows 2011 TR
MS Office 365 TR - 64bit

VBA, Selenium ve VBS
Altın Üyelik Bitiş Tarihi
08-04-2026
Merhaba

Ekteki dosyada Adisyon Hareketleri Raporu sekmesindeki AN:AQ sütunlarına, Veri Yeni sekmesinden düşey ara ile veri getirtiyorum.

Her gün satışları ekliyorum ve böylece dosya büyüdükçe maalesef formül yavaşlıyor. Bunu makro ile yapmama yardımcı olabilir misiniz rica etsem.
Makroyu etkinleştirmen gerekir.
 

Ekli dosyalar

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,543
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,
Alternatif olsun.

Kod:
Sub BulGetir()

Dim c As Range
Dim i As Long

Application.ScreenUpdating = False

For i = 2 To Sayfa1.Cells(Rows.Count, "M").End(3).Row
    
    Set c = Sayfa2.Range("A:A").Find(Sayfa1.Cells(i, "M"), LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
        Sayfa1.Cells(i, "AN") = c.Offset(0, 1)
        Sayfa1.Cells(i, "AO") = c.Offset(0, 2)
        Sayfa1.Cells(i, "AP") = c.Offset(0, 3)
        Sayfa1.Cells(i, "AQ") = c.Offset(0, 4)
    End If
    
Next i

Application.ScreenUpdating = True

End Sub
 

serkans

Altın Üye
Katılım
18 Ekim 2004
Mesajlar
171
Excel Vers. ve Dili
Office LTSC Pro Plus 21 64 Bit
Altın Üyelik Bitiş Tarihi
21-07-2028
Merhaba,
Alternatif olsun.

Kod:
Sub BulGetir()

Dim c As Range
Dim i As Long

Application.ScreenUpdating = False

For i = 2 To Sayfa1.Cells(Rows.Count, "M").End(3).Row
   
    Set c = Sayfa2.Range("A:A").Find(Sayfa1.Cells(i, "M"), LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
        Sayfa1.Cells(i, "AN") = c.Offset(0, 1)
        Sayfa1.Cells(i, "AO") = c.Offset(0, 2)
        Sayfa1.Cells(i, "AP") = c.Offset(0, 3)
        Sayfa1.Cells(i, "AQ") = c.Offset(0, 4)
    End If
   
Next i

Application.ScreenUpdating = True

End Sub
Hocam çok teşekkür ederim. Dosyaya başka sekmeler de eklenince, mevcut sekmeler 4 ve 5. sıraya geldiler. Sizin verdiğiniz Sayfa1 ve Sayfa 2 yi de buna göre güncelledim. Ama maalesef dondu ekran ama bitince de makto çalışmadı. neden olabilir?
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,543
Excel Vers. ve Dili
Ofis 365 Türkçe
Dosyayı görmeden ne diyebilirim ki?
 
Üst