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

时间:2017-05-12 09:30:15

标签: excel vba excel-vba duplicates

我正在尝试在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&中对行进行求和。 D并删除重复的行...

抱歉说不好......

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

4 个答案:

答案 0 :(得分:0)

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

答案 1 :(得分:0)

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

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 :(得分:0)

或者您可以尝试这样的事情......

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

答案 3 :(得分:0)

  

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