formülle yapılan işlemi makroyla yapmak istiyorum

[siyar0044]

arkadaşlar ekte ki excel çalışma kitabındaki
özet safyasındaki mavi renkle işaretlediim kısımdaki işlemi formülle değilde makroyla yapmak istiyorum yardım ederseniz sevinirim

çalışmada malzemeler sayfasında b sutununda malzeme listesi giriliyor (ben örnek olsun diye 10 kalem girdim sayı çok uzun olabilir)

liste sayfasında belirttiğim tarhlerde kullanılan malzemelrin miktarı ve listesini giriyorum ve AT sutunundada bir nevi icmal oluşturdum.

özet sayfasında isemavi renkle işaretlediğim hücrelerde =TOPLA.ÇARPIM((liste!$B$7:$B$10000>=TARİHSAYISI(SOLDAN($B9;10)))*(liste!$B$7:$B$10000<=TARİHSAYISI(SAĞDAN($B9;10)))*(liste!$P$7:$AR$10000=E$3);(liste!$O$7:$AQ$10000)) formülünü kullanarak B sutununda belirttiğim tarihler arasında kullanılan malzemelrin toplam miktarını elde ediyorum bu işlem bu formülle çalışıyor ancak malzeme listesi çok olduğundan işlem çok uzun sürüyor o yüzden bu formülü makroyla yapmak istiyorum


not: istediğim sadece özet sayfasındaki formülü makroyla yapmak diğer kısımlar zaten çalışıyor yardım ederseniz sevinirim

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub ÖZET_TABLO()
    Dim DATA As Worksheet, X As Long, Y As Integer
    Dim İLK_TARİH As Date, SON_TARİH As Date
    Dim BUL As Range, ADRES As String
    
    Application.ScreenUpdating = False
    
    Set DATA = Sheets("LİSTE")
    
    Sheets("ÖZET").Select
    Range("E9:IV19").ClearContents
    
    For X = 9 To Range("B65536").End(3).Row
        İLK_TARİH = Split(Cells(X, 2), "-")(0)
        SON_TARİH = Split(Cells(X, 2), "-")(1)
        
        For Y = 5 To 256
            If Cells(3, Y) <> 0 Or Cells(3, Y) <> Empty Then
            Set BUL = DATA.Cells.Find(Cells(3, Y), LookAt:=xlWhole)
            If Not BUL Is Nothing Then
            ADRES = BUL.Address
            Do
            If DATA.Cells(BUL.Row, 2) >= İLK_TARİH And DATA.Cells(BUL.Row, 2) <= SON_TARİH Then
            Cells(X, Y) = Cells(X, Y) + DATA.Cells(BUL.Row, BUL.Column - 1)
            End If
            Set BUL = DATA.Cells.FindNext(BUL)
            Loop While Not BUL Is Nothing And BUL.Address <> ADRES
            End If
            End If
        Next
    Next
    
    Set BUL = Nothing
    Set DATA = Nothing
 
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub