• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Topla.Çarpım VBA kodu

  • Konbuyu başlatan Konbuyu başlatan walabi
  • Başlangıç tarihi Başlangıç tarihi
W

walabi

Altın Üye
Katılım
22 Eylül 2012
Mesajlar
1,080
Excel Vers. ve Dili
excel 2010

excel 2013
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' 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
Genişletmek için tıkla ...


Formül olanı çalıştıramadım, benden kaynaklanıyor olabilir. Ancak kod çalışıyor. Teşekkürler.
 
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
Genişletmek için tıkla ...


Ü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
 

Ekli dosyalar

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
Genişletmek için tıkla ...


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' Alıntı:
Konuyu anladığım kadar yapılan çalışma.
Genişletmek için tıkla ...

Ü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?



256623
 
Yemek adına ait içerik tekrarı malzemelerin hepsini toplar
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst