Topla.Çarpım VBA kodu

walabi · 15 Mart 2025

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ü

Kod:

=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

Kod:

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

pitchoute · 15 Mart 2025

Merhaba, şöyle dener misiniz;

Kod:

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:

Kod:

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

Korhan Ayhan · 15 Mart 2025

Faydalı olabilir...

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

walabi · 15 Mart 2025

pitchoute' Alıntı:

Merhaba, şöyle dener misiniz;

Kod:

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:

Kod:

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 · 19 Mart 2025

pitchoute' Alıntı:

Merhaba, şöyle dener misiniz;

Kod:

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:

Kod:

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.

Kod:

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

pitchoute · 19 Mart 2025

Şöyle dener misiniz hocam;

Kod:

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

walabi · 19 Mart 2025

pitchoute' Alıntı:

Şöyle dener misiniz hocam;

Kod:

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 · Perşembe saat 00:17'de

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

walabi · Perşembe saat 00:42'de

Ziynettin' Alıntı:
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 · Perşembe saat 11:48'de

Ziynettin' Alıntı:
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 · Perşembe saat 11:58'de

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

Topla.Çarpım VBA kodu

walabi

pitchoute

Korhan Ayhan

Administrator

walabi

walabi

Ekli dosyalar

pitchoute

walabi

Ziynettin

Destek Ekibi

Ekli dosyalar

walabi

walabi

Ziynettin

Destek Ekibi