Excel VBA 在第 2 列中查找重复项，然后对第 3 列和第 4 列中的行求和答案

【问题标题】：Excel VBA find duplicates in 1st 2 columns and then sum rows in 3rd & 4th columnExcel VBA 在第 2 列中查找重复项，然后对第 3 列和第 4 列中的行求和
【发布时间】：2017-10-11 13:30:44
【问题描述】：

我正在尝试在 excel 中制作 vba 代码，但未能成功，也很难在互联网上找到解决方案。

例子：

     A | B | C | D 

1    Z | Y | 1 | 6
2    Z | Y | 2 | 5
3    Y | Z | 3 | 4
4    X | X | 1 | 2
5    P | Z | 4 | 3
6    P | Z | 5 | 2
7    P | Y | 6 | 1

If Column A1 & A2 are same (Duplicates) then
look in B1 & B2
     if B1 & B2 also duplicates then
          C1 + C2  &  D1 + D2
              and delete rows 2 and 6

宏之后：

     A | B | C | D  

1    Z | Y | 3 | 11
2    Y | Z | 3 | 4
3    X | X | 1 | 2
4    P | Z | 9 | 5
5    P | Y | 6 | 1


rows 2 and 6 were deleted

因此，如果 A 列包含重复项，则在那些重复的行中查找 B 列并在那里找到重复项。如果 B 列中也存在重复项，则对列 C 和 D 中的行求和并删除重复的行...

抱歉解释不好...

非常感谢，最好的祝福，马里奥

【问题讨论】：

你试过为此写一些代码吗？
这是一个很好的例子，说明通常可以通过使用数据透视表来完成。

标签： vba excel duplicates

【解决方案1】：

另一个类似的解决方案..

Sub test()
Dim i As Integer

i = Range("A65536").End(xlUp).Row

For K = 2 To i + 1
A = Range("A" & K).Value
B = Range("B" & K).Value

aup = Range("A" & (K - 1)).Value
bup = Range("B" & (K - 1)).Value

If A = aup And B = bup Then
Range("C" & K).Value = Range("C" & K).Value + Range("C" & K - 1).Value
Range("D" & K).Value = Range("D" & K).Value + Range("D" & K - 1).Value


Rows(K - 1).Select
Rows(K - 1).Delete
End If

Next

End Sub

【讨论】：

【解决方案2】：

以下解决方案假定您的数据已按 A 列按第一顺序排序，B 列按第二顺序排序。如果没有，请确保这样做。

另外，如果您有三次重复，那么您可能需要再次运行它。

Sub MergeRows()

  Dim i As Integer        'Tracks Rows in Original Table
  Dim ii As Integer       'Tracks Rows in New Table
  Dim v As Variant        'Reads all data into array for speed

  v = Range("A1:D7")      'Change According to your needs

  ii = 1

  For i = 1 To UBound(v, 1) - 1
    'Check that A and B are duplicates
    If v(i, 1) = v(i + 1, 1) And v(i, 2) = v(i + 1, 2) Then
        'Sum up columns C and D
        Cells(ii, 3) = v(i, 3) + v(i + 1, 3)
        Cells(ii, 4) = v(i, 4) + v(i + 1, 4)

        Rows(ii + 1).Delete
        ii = ii - 1
    End If

    ii = ii + 1

  Next

End Sub

【讨论】：

【解决方案3】：

或者你可以试试这样的...

Sub SummarizeData()
Dim lr As Long, i As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = lr To 2 Step -1
    If Cells(i, 1) = Cells(i - 1, 1) And Cells(i, 2) = Cells(i - 1, 2) Then
        Cells(i - 1, 3) = Cells(i - 1, 3) + Cells(i, 3)
        Cells(i - 1, 4) = Cells(i - 1, 4) + Cells(i, 4)
        Range("A" & i & ":D" & i).Delete shift:=xlUp
    End If
Next i
Application.ScreenUpdating = True
End Sub

【讨论】：

【解决方案4】：

Sub SummarizeData() Dim lr As Long, i As Long Application.ScreenUpdating = False lr = Cells(Rows.Count, 1).End(xlUp).Row For i = lr To 2 Step -1 如果 Cells(i, 1) = Cells(i - 1, 1) 并且 Cells(i, 2) = Cells(i - 1, 2) 那么细胞(i - 1, 3) = 细胞(i - 1, 3) + 细胞(i, 3) 细胞(i - 1, 4) = 细胞(i - 1, 4) + 细胞(i, 4) Range("A" & i & ":D" & i).Delete shift:=xlUp End If Next i Application.ScreenUpdating = True End Sub

我发现这很有帮助，当我尝试将其应用于我现有的，通过将其更改为 Range 时，它失败了。

例如，将单元格 A 和 B 从单个字符更改为如下所示：

 A | B | C | D

1 010 | ACPT | 1 | 6

2 010 | RJCT | 2 | 5

3 110 | ACPT | 3 | 4

4 011 | RJCT | 1 | 2

5 010 | ACPT | 4 | 3

6 010 | RJCT | 5 | 2

7 110 | ACPT | 6 | 1

【讨论】：