如果A列包含“ D列”且B列包含“ E列”，则添加值

Question

我想编写一个宏来读取A列和 B列中的单词，以查看它们是否分别与E列和 F列中的单词匹配， 然后 将 C列中的值添加到G列中。

例如：

例如，您可以看到A列和B列中有“ Lion”和“ Horse”两个实例，因此G列具有这两个实例的总数（10 + 8 = 18）。

不幸的是，我所做的尝试只是将值从C列复制到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

我知道我对“ x”（可能还有很多其他事情）做错了事，但我想不出一种使它起作用的方法。 有什么办法可以改变它，使其像我的示例图片中那样将总数相加？

非常感谢您的帮助。

Answer 1

它必须是宏吗？ 您可以将=SUMIFS(C:C,A:A,E2,B:B,F2)放入G2并填写：

如果您真的想在宏中使用它，则可能是这样的：

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

除非有充分的理由，否则一个简单的SUMIFS循环应该起作用：

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

Answer 3

这样的事情可能会起作用，尽管可能有些过大：

您将字符串中的前两个单元连接起来，并且此字符串用作字典的键。 然后，只要找到相似的内容，便将其值添加到字典中。 最后，您可以打印字典。

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