2017-05-12 49 views
0

我想在Excel中創建一個vba代碼,但是沒有這樣做也很難在互聯網上找到解決方案。Excel VBA在第1列中找到重複項,然後在第3和第4列中總結行數

例子:

 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列再總結行在山坳Ç& d和刪除重複的行...

對不起,我不好解釋...

非常感謝你, 最好的問候, 馬里奧

+4

你試過寫這樣的代碼? –

+2

這是一個很好的例子,通常可以通過使用一個數據透視表來完成。 – jkpieterse

回答

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 
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 
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 
相關問題