Question

我正在尝试在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列中，则在col C＆amp;中对行进行求和。 D并删除重复的行...

抱歉说不好......

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

Answer 1

以下解决方案假定您的数据已按第一顺序的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

Answer 2

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

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

Answer 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

Answer 4

Sub SummarizeData（）Dim lr长，我长 Application.ScreenUpdating = False lr = Cells（Rows.Count， 1）.End（xlUp）.Row For i = lr To 2 Step -1 如果单元格（i，1）=单元格（i-1，1）和单元格（i，2）=单元格（i-1，2）那么像元（i-1，3）=像元（i-1，3）+像元（i，3）像元（i-1，4）=像元（i-1，4）+像元（i，4） Range（“ A”＆i＆“：D”＆i）。删除移位：= xlUp 如果下一个i Application.ScreenUpdating = True结束，则结束

我发现这很有用，当我尝试将其更改为Range时，将其应用于我现有的产品时失败了。

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

 A | B | C | D

1,010 | ACPT | 1 | 6

2 010 | RJCT | 2 | 5

3110 | ACPT | 3 | 4

4 011 | RJCT | 1 | 2

5 010 | ACPT | 4 | 3

6010 | RJCT | 5 | 2

7 110 | ACPT | 6 | 1

Excel VBA在前2列中找到重复项，然后在第3列和第3列中对行进行求和。第四栏

4 个答案: