Wenn Spalte A enthält "Spalte D" UND Spalte B enthält "Spalte E" DANN Wert hinzufügen

Question

Ich möchte ein Makro schreiben, das Wörter in Spalte A und B liest, um zu sehen, ob sie Wörter in Spalte E übereinstimmen und bzw. F dannfügen den Wert in Spalte C-Säule G.

zum Beispiel:

Sie sehen können, zum Beispiel, dass es in den Spalten A und B zwei Instanzen von "Lion" und "Horse" gibt, also hat Spalte G die Summe der beiden (10 + 8 = 18).

Leider ist der Versuch machte ich nur kopiert die Werte aus Spalte C bis Spalte G:

Sub CombineAnimals() 

lastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row 

For x = 1 To lastRow 
    If InStr(1, Sheets("Sheet1").Cells(x, 1), Cells(x, 5)) <> 0 _ 
    And InStr(1, Sheets("Sheet1").Cells(x, 2), Cells(x, 6)) <> 0 Then 
     Sheets("Sheet1").Cells(x, 7).Value = _ 
     Sheets("Sheet1").Cells(x, 7).Value + Cells(x, 3) 
    End If 
Next x 

End Sub 

Ich weiß, ich bin etwas falsch mit dem „x“ (und wahrscheinlich viele andere Dinge) zu tun, aber Ich kann keinen Weg finden, es zum Laufen zu bringen. Gibt es eine Möglichkeit, dies zu ändern, so fügt es die Summen zusammen, wie es in meinem Beispielbild tut?

Vielen Dank für Ihre Hilfe.

Answer 1

Hat es ein Makro sein? Sie könnten nur in =SUMIFS(C:C,A:A,E2,B:B,F2) in G2 setzen und füllen nach unten:

Sub CombineAnimals() 

    Range("G2").FormulaR1C1 = "=SUMIFS(C[-4],C[-6],RC[-2],C[-5],RC[-1])" 
    Range("G2").AutoFill Destination:=Range("G2:G" & Range("F" & ActiveSheet.Cells.Rows.Count).End(xlUp).Row) 

End Sub 

Answer 2

So etwas wie dies funktionieren wird, auch wenn es ein bisschen zu viel des Guten kann:

Sie verketten die ersten beiden Zellen in einem String und diese Zeichenfolge wird als Schlüssel für ein Wörterbuch verwendet. Wenn Sie etwas Ähnliches gefunden haben, fügen Sie den Wert zum Wörterbuch hinzu. Am Ende können Sie das Wörterbuch ausdrucken.

Option Explicit 

Public Sub TestMe() 

    Dim dict   As Object 
    Dim rngCell   As Range 

    Dim rngInput  As Range 
    Dim strInput  As String 
    Dim dblInput  As Double 
    Dim lngCounter  As Long 
    Dim varKey   As Variant 

    Set dict = CreateObject("Scripting.Dictionary") 
    Set rngInput = ActiveSheet.Range("A2:A6") 


    For Each rngCell In rngInput 
     strInput = rngCell.Value & rngCell.Offset(0, 1).Value 
     dblInput = rngCell.Offset(0, 2).Value 

     If dict.exists(strInput) Then 
      dict(strInput) = dict(strInput) + dblInput 
     Else 
      dict.Add strInput, dblInput 
     End If 
    Next rngCell 


    For Each varKey In dict.keys 
     Debug.Print varKey, dict(varKey) 
    Next varKey 


End Sub 

Answer 3

Es sei denn, es gibt gute Gründe nicht zu, sollte eine einfache SUMIFS Schleife arbeiten:

Sub CombineAnimals() 
With Sheets("Sheet1") 
    lastRow = .Range("E" & .Rows.Count).End(xlUp).Row 

    For x = 2 To lastRow 
     .Cells(x, "G").Value = Application.SumIfs(.Range("C:C"), .Range("A:A"), .Cells(x, "E"), .Range("B:B"), .Cells(x, "F")) 
    Next x 
End With 
End Sub