Topla.Çarpım VBA kodu

[walabi]

Merhaba,

Aşağıda topla.çarpım ile oluşturmaya çalıştığım kod var. Ancak hata veriyor. Hata sebebi nedir. Normal fonksiyonun işleyişine göre vba ya uyarlamaya çalıştım. Ancak olmadı.



Bu formülü

=TOPLA.ÇARPIM(ESAYIYSA(KAÇINCI(REÇETE!$B$2:$B$9999;K2;0))*ESAYIYSA(KAÇINCI(REÇETE!$C$2:$C$9999;L2;0))*ESAYIYSA(KAÇINCI(REÇETE!$A$2:$A$9999;$G$2:$G$151;0))*(REÇETE!$D$2:$D$9999))

Bu VBA koduna uyarlamaya çalıştım

For i = 2 To sonsat



    s2.Cells(i, "M") = WorksheetFunction.SumProduct( _
                        (WorksheetFunction.IsNumber(WorksheetFunction.Match(s3.Range("B2:B9999"), s2.Cells(i, "K"), 0))) * _
                        (WorksheetFunction.IsNumber(WorksheetFunction.Match(s3.Range("L2:L9999"), s2.Cells(i, "L"), 0))) * _
                        (WorksheetFunction.IsNumber(WorksheetFunction.Match(s3.Range("A2:A9999"), s2.Range("G2:G" & sonsat), 0))) * _
                        (s3.Range("D2:D9999")))


Next i

 

[Korhan Ayhan]

Faydalı olabilir...

https://www.excel.web.tr/threads/topla-carpim-sumproduct-fonksiyonunun-vba-icindeki-farkli-kullanimlari.82178/

 

[walabi]

Merhaba, şöyle dener misiniz;

For i = 2 To sonsat
    s2.Cells(i, "M").Formula = "=TOPLA.ÇARPIM(ESAYIYSA(KAÇINCI(" & s3.Name & "!$B$2:$B$9999;" & s2.Cells(i, "K").Address(False, False) & ";0))*ESAYIYSA(KAÇINCI(" & s3.Name & "!$C$2:$C$9999;" & s2.Cells(i, "L").Address(False, False) & ";0))*ESAYIYSA(KAÇINCI(" & s3.Name & "!$A$2:$A$9999;$G$2:$G$" & sonsat & ";0))*(" & s3.Name & "!$D$2:$D$9999))"
Next i

Formulün işleyişine göre VBA kodu isterseniz eğer:

Dim toplam As Double
Dim j As Long
Dim bulundu As Boolean

For i = 2 To sonsat
    toplam = 0
    For j = 2 To 9999
        If IsEmpty(s3.Cells(j, "A").Value) And IsEmpty(s3.Cells(j, "B").Value) Then Exit For
       
        If s3.Cells(j, "B").Value = s2.Cells(i, "K").Value And _
           s3.Cells(j, "C").Value = s2.Cells(i, "L").Value Then
            bulundu = False
            For k = 2 To sonsat
                If s3.Cells(j, "A").Value = s2.Cells(k, "G").Value Then
                    bulundu = True
                    Exit For
                End If
            Next k
            If bulundu Then
                toplam = toplam + s3.Cells(j, "D").Value
            End If
        End If
    Next j
    s2.Cells(i, "M").Value = toplam
Next i

Formül olanı çalıştıramadım, benden kaynaklanıyor olabilir. Ancak kod çalışıyor. Teşekkürler.

 

[walabi]

Merhaba, şöyle dener misiniz;

For i = 2 To sonsat
    s2.Cells(i, "M").Formula = "=TOPLA.ÇARPIM(ESAYIYSA(KAÇINCI(" & s3.Name & "!$B$2:$B$9999;" & s2.Cells(i, "K").Address(False, False) & ";0))*ESAYIYSA(KAÇINCI(" & s3.Name & "!$C$2:$C$9999;" & s2.Cells(i, "L").Address(False, False) & ";0))*ESAYIYSA(KAÇINCI(" & s3.Name & "!$A$2:$A$9999;$G$2:$G$" & sonsat & ";0))*(" & s3.Name & "!$D$2:$D$9999))"
Next i

Formulün işleyişine göre VBA kodu isterseniz eğer:

Dim toplam As Double
Dim j As Long
Dim bulundu As Boolean

For i = 2 To sonsat
    toplam = 0
    For j = 2 To 9999
        If IsEmpty(s3.Cells(j, "A").Value) And IsEmpty(s3.Cells(j, "B").Value) Then Exit For
       
        If s3.Cells(j, "B").Value = s2.Cells(i, "K").Value And _
           s3.Cells(j, "C").Value = s2.Cells(i, "L").Value Then
            bulundu = False
            For k = 2 To sonsat
                If s3.Cells(j, "A").Value = s2.Cells(k, "G").Value Then
                    bulundu = True
                    Exit For
                End If
            Next k
            If bulundu Then
                toplam = toplam + s3.Cells(j, "D").Value
            End If
        End If
    Next j
    s2.Cells(i, "M").Value = toplam
Next i

Üstad daha önce cevapladığın şu koda bakma şansın var mı? Dosyayı ekledim. İkinci modülde.
Yazdığın kodların aslına uygun olarak rütuşladım. Ancak kod bloğu benim düşündüğüm toplamı sağlamıyor. Örneğin eklediğim son durumda malzeme listesi adlı sayda I sütununda AYVA miktarı 100 görüünüyor. Ancak olması gereken 300. Aynı sayfada AYVA KOMPOSTO 3 defa geçiyor. Konu açarken bu durumu kaçımışım.

Sub Miktar_Topla()

Dim s1 As Worksheet
Dim s2 As Worksheet
Dim s3 As Worksheet



Dim toplam As Double
Dim j As Long
Dim i As Long
Dim k As Long
Dim bulundu As Boolean

Set s1 = Sheets("AYLIK MENÜ")
Set s2 = Sheets("MALZEME LİSTESİ")
Set s3 = Sheets("REÇETE")




sonsat = s2.Cells(Rows.Count, "I").End(3).Row

For i = 2 To s2.Cells(Rows.Count, "I").End(3).Row
    toplam = 0
    For j = 2 To s3.Cells(Rows.Count, "A").End(3).Row
        If IsEmpty(s3.Cells(j, "A").Value) And IsEmpty(s3.Cells(j, "B").Value) Then Exit For
        
        If s3.Cells(j, "B").Value = s2.Cells(i, "I").Value And _
           s3.Cells(j, "C").Value = s2.Cells(i, "J").Value Then
            bulundu = False
            For k = 2 To sonsat
                If s3.Cells(j, "A").Value = s2.Cells(k, "G").Value Then
                    bulundu = True
                    Exit For
                End If
            Next k
            If bulundu Then
                toplam = toplam + s3.Cells(j, "D").Value
            End If
        End If
    Next j
    s2.Cells(i, "K").Value = toplam
Next i

End Sub

 

[walabi]

Şöyle dener misiniz hocam;

Sub Miktar_Topla()
    Dim s1 As Worksheet
    Dim s2 As Worksheet
    Dim s3 As Worksheet
  
    Dim toplam As Double
    Dim j As Long
    Dim i As Long
  
    Set s1 = Sheets("AYLIK MENÜ")
    Set s2 = Sheets("MALZEME LİSTESİ")
    Set s3 = Sheets("REÇETE")
  
    For i = 2 To s2.Cells(Rows.Count, "I").End(xlUp).Row
        toplam = 0
        For j = 2 To s3.Cells(Rows.Count, "A").End(xlUp).Row
            If Not IsEmpty(s3.Cells(j, "A").Value) Or Not IsEmpty(s3.Cells(j, "B").Value) Then
                If s3.Cells(j, "B").Value = s2.Cells(i, "I").Value And _
                   s3.Cells(j, "C").Value = s2.Cells(i, "J").Value Then
                    toplam = toplam + s3.Cells(j, "D").Value
                End If
            End If
        Next j
        s2.Cells(i, "K").Value = toplam
    Next i
End Sub

Bu hali ile s3 deki A sütununu dikkate almadan B sütunundaki tüm verileri topluyor anladığım kadarı ile. Olması gereken sonucu vermedi.

 

[Ziynettin]

Konuyu anladığım kadar yapılan çalışma.

 

[walabi]

Konuyu anladığım kadar yapılan çalışma.

Syn @Ziynettin doğru anlamışsınız. Ve çok hızlı sonuç veriyor. Syn @pitchoute nın kodlarının arasına eğersay sıkıştırarak çözüme ulaşmıştım. Ancak zaman alıyordu. Bu hali ile anında sonuç alabiliyorum. Ellerinize sağlık.

 

[walabi]

Konuyu anladığım kadar yapılan çalışma.

Üstad, şöylesi bir sorum olacak. Yazmış olduğunuz kod bloğuna istinaden, REÇETE adlı sayfada aşağıdaki gibi tekrar eden veriler varsa çıkan sonuçlar sanırım hatalı olacaktır. Doğru mudur?

 

[Ziynettin]

Yemek adına ait içerik tekrarı malzemelerin hepsini toplar