Excel VBAは第1列で重複を見つけて第3列と第4列の行を合計します

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にもある場合、

はどうもありがとうございました...悪い説明のために申し訳ありません

を...コルCで& Dを行を合計し、重複行を削除し、 よろしく、 マリオ

Answer 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 

Answer 2

次の解決策では、データが既に列Aで1番目、列Bで2番目にソートされていることが前提です。そうでない場合は、必ず行ってください。

また、3重になっている場合は、もう一度実行する必要があります。

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 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