如果另一列中的值=特定，则VBA对特定列中的单元格值求和

Question

如果“E”列中的值相同且“G”列中的值为“Kede”，我正在尝试对“I”列中的值求和并删除重复行。

我有一段我不完全理解的代码，我正在尝试根据我的需要进行修改。最初，此代码在“E”列中查找重复值，并在“I”列中求和，以删除重复的行。

'Declare variables
Dim AcSh As Worksheet, LastRow As Long, dict As Object
Dim rngDel As Range, arrE, arrInt, arrI, i As Long, dKey
 
Set AcSh = ActiveSheet
LastRow = AcSh.Range("E" & AcSh.Rows.Count).End(xlUp).Row
 
arrE = AcSh.Range("E2:E" & LastRow).Value
Set dict = CreateObject("Scripting.Dictionary")
 
'Sum and delete duplicates
On Error Resume Next
For i = 1 To UBound(arrE)

    If Not dict.Exists(arrE(i, 1)) Then
    dict.Add arrE(i, 1), AcSh.Range("I" & i + 1).Address & "|" & CDbl(AcSh.Range("I" & i + 1).Value)
    Else
    arrInt = Split(dict(arrE(i, 1)), "|")
    dict(arrE(i, 1)) = arrInt(0) & "|" & CDbl(arrInt(1)) + CDbl(AcSh.Range("I" & i + 1).Value)
    
    If rngDel Is Nothing Then
    Set rngDel = AcSh.Range("E" & i + 1)
    Else
    Set rngDel = Union(rngDel, AcSh.Range("E" & i + 1))
    End If
    End If
    
Next i
 
On Error Resume Next
ReDim arrI(1 To LastRow, 1 To 1)

    For Each dKey In dict.keys()
    arrInt = Split(dict.Item(dKey), "|")
    arrI(Range(arrInt(0)).Row - 1, 1) = CDbl(arrInt(1))
    Next
    If Not rngDel Is Nothing Then
    AcSh.Range("I2").Resize(LastRow - 1, 1).Value = arrI
    rngDel.EntireRow.Delete
    End If

这就是我目前所拥有的

'Declare variables
     Dim AcSh As Worksheet, LastRow As Long, dict As Object
     Dim rngDel As Range, arrG, arrInt, arrI, i As Long, dKey
 
     Set AcSh = ActiveSheet
     LastRow = AcSh.Range("G" & AcSh.Rows.Count).End(xlUp).Row
 
     arrG = AcSh.Range("G2:G" & LastRow).Value
     Set dict = CreateObject("Scripting.Dictionary")

'Sum and delete duplicates
On Error Resume Next
For i = 1 To UBound(arrG)

If Not dict.Exists(arrG(i, 1)) And ThisWorkbook.Worksheets("BOM").Range(i, G).Value = "Kede" Then

dict.Add arrG(i, 1), AcSh.Range("I" & i + 1).Address & "|" & CDbl(AcSh.Range("I" & i + 1).Value)
Else:
arrInt = Split(dict(arrG(i, 1)), "|")
dict(arrG(i, 1)) = arrInt(0) & "|" & CDbl(arrInt(1)) + CDbl(AcSh.Range("I" & i + 1).Value)
    
    If rngDel Is Nothing Then
    Set rngDel = AcSh.Range("G" & i + 1)
    Else:
    Set rngDel = Union(rngDel, AcSh.Range("G" & i + 1))
    End If
End If

Next i

On Error Resume Next
ReDim arrI(1 To LastRow, 1 To 1)

For Each dKey In dict.keys()
    arrInt = Split(dict.Item(dKey), "|")
    arrI(Range(arrInt(0)).Row - 1, 1) = CDbl(arrInt(1))
Next

If Not rngDel Is Nothing Then
AcSh.Range("I2").Resize(LastRow - 1, 1).Value = arrI
rngDel.EntireRow.Delete
End If

所以基本上我试图在原始代码中添加一个更多标准，如果“G”列中的值是“Kede”，它也会查找。 有人可以帮我修改这段代码并向我解释得更清楚吗？

Answer 1

如果我理解正确，您想忽略并删除 G 列中没有“Kede”的行。如果是这样，这段代码应该通过在开头删除它们来解决问题。

    'Declare variables
    Dim AcSh As Worksheet, LastRow As Long, dict As Object
    Dim rngDel As Range, arrE, arrInt, arrI, i As Long, dKey
     
 
    Set AcSh = ActiveSheet
    LastRow = AcSh.Range("E" & AcSh.Rows.Count).End(xlUp).Row
    
    'Remove non-Kede rows and reset LastRow
    For i = LastRow + 1 To 2 Step -1
        If AcSh.Range("G" & i).Value <> "Kede" Then AcSh.Range("G" & i).EntireRow.Delete
    Next i
    LastRow = AcSh.Range("E" & AcSh.Rows.Count).End(xlUp).Row
    
    arrE = AcSh.Range("E2:E" & LastRow).Value
    Set dict = CreateObject("Scripting.Dictionary")
     
     
    'Sum and delete duplicates
    On Error Resume Next
    For i = 1 To UBound(arrE)
    
        If Not dict.Exists(arrE(i, 1)) Then
        dict.Add arrE(i, 1), AcSh.Range("I" & i + 1).Address & "|" & CDbl(AcSh.Range("I" & i + 1).Value)
        Else
        arrInt = Split(dict(arrE(i, 1)), "|")
        dict(arrE(i, 1)) = arrInt(0) & "|" & CDbl(arrInt(1)) + CDbl(AcSh.Range("I" & i + 1).Value)
        
        If rngDel Is Nothing Then
        Set rngDel = AcSh.Range("E" & i + 1)
        Else
        Set rngDel = Union(rngDel, AcSh.Range("E" & i + 1))
        End If
        End If
        
    Next i
     
    On Error Resume Next
    ReDim arrI(1 To LastRow, 1 To 1)

    For Each dKey In dict.keys()
    arrInt = Split(dict.Item(dKey), "|")
    arrI(Range(arrInt(0)).Row - 1, 1) = CDbl(arrInt(1))
    Next
    If Not rngDel Is Nothing Then
    AcSh.Range("I2").Resize(LastRow - 1, 1).Value = arrI
    rngDel.EntireRow.Delete
    End If

编辑：感谢下面的 cmets，我相信我现在明白了您的期望。我很确定这不是解决问题的最有说服力的方法，但我认为它有效。请尝试。

    'Declare variables
    Dim AcSh As Worksheet, LastRow As Long, dict As Object
    Dim rngDel As Range, arrE, arrInt, arrI, i As Long, dKey
     
    

    
    Set AcSh = ActiveSheet
    LastRow = AcSh.Range("E" & AcSh.Rows.Count).End(xlUp).Row
    
    'Remove non-Kede rows and reset LastRow
   ' For i = LastRow + 1 To 2 Step -1
   '     If AcSh.Range("G" & i).Value <> "Kede" Then AcSh.Range("G" & i).EntireRow.Delete
   ' Next i
    LastRow = AcSh.Range("E" & AcSh.Rows.Count).End(xlUp).Row
    
    arrE = AcSh.Range("E2:E" & LastRow).Value
    arrG = AcSh.Range("G2:G" & LastRow).Value
    Set dict = CreateObject("Scripting.Dictionary")
     
     

    'Sum and delete duplicates
    On Error Resume Next
    For i = 1 To UBound(arrE)
    
        If Not dict.Exists(arrE(i, 1) & arrG(i, 1)) Then
            dict.Add arrE(i, 1) & arrG(i, 1), AcSh.Range("I" & i + 1).Address & "|" & CDbl(AcSh.Range("I" & i + 1).Value)
        ElseIf arrG(i, 1) = "Kede" Then
            arrInt = Split(dict(arrE(i, 1) & arrG(i, 1)), "|")
            dict(arrE(i, 1) & arrG(i, 1)) = arrInt(0) & "|" & CDbl(arrInt(1)) + CDbl(AcSh.Range("I" & i + 1).Value)
            
            If rngDel Is Nothing Then
                Set rngDel = AcSh.Range("E" & i + 1)
            Else
                Set rngDel = Union(rngDel, AcSh.Range("E" & i + 1))
            End If
        Else
            dict.Add AcSh.Range("E" & i + 1).Address, AcSh.Range("I" & i + 1).Address & "|" & CDbl(AcSh.Range("I" & i + 1).Value)
        End If
        
    Next i
     
    On Error Resume Next
    ReDim arrI(1 To LastRow, 1 To 1)

    For Each dKey In dict.keys()
        arrInt = Split(dict.Item(dKey), "|")
        arrI(Range(arrInt(0)).Row - 1, 1) = CDbl(arrInt(1))
    Next
    If Not rngDel Is Nothing Then
        AcSh.Range("I2").Resize(LastRow - 1, 1).Value = arrI
        rngDel.EntireRow.Delete
    End If

Answer 2

这段代码肯定有点混乱。本质上，他们正在使用来自 E:E 的键和来自 I:I 的值制作一个字典。可能可以重做，但我可以建议一个更简单的替代方案：数据透视表。它们更灵活，更不容易折断。我整理了一张模拟表，以表明您希望它看起来像：

自己做这个：

1. 选择包含数据的列 (E:I)
2. 单击插入 -> 数据透视表
3. 将列 E:E、G:G 和 I:I 的标题名称拖动到图片中 Column1、Column2 和 Column3 所在的位置。
4. 更换过滤器科德

我希望这会有所帮助！如果您有任何问题，我会尽力提供帮助。