我的数据如下: 样本数据:
A B C Result:
DG M 1 DG M 5
DG M 2 KH M 9
DG M 2 SG C 7
KH M 4 KH M 5
KH M 5 DG M 5
SG C 6
SG C 1
KH M 3
KH M 2
DG M 5
我在这里有3列,如果A列和B列中的行与上一行相同,我希望对值求和。
下面是我从其他人那里引用的代码。但是代码似乎只有一个条件,我想寻求一种添加另一个条件的方法。谢谢。
Sub MG()
Dim Rng As Range, Dn As Range, n As Double, nRng As Range
Set Rng = Worksheets("sheet1").Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
If Not .Exists(Dn.Value) Then
.Add Dn.Value, Dn
Else
If nRng Is Nothing Then Set nRng = Dn Else Set nRng = Union(nRng, Dn)
.Item(Dn.Value).Offset(, 3) = .Item(Dn.Value).Offset(, 3) + Dn.Offset(, 3)
End If
Next
If Not nRng Is Nothing Then nRng.EntireRow.Delete
End With
End Sub
答案 0 :(得分:2)
这是另一种方法:
Sub MG()
Dim Rng As Range, n As Double, j As Long
j = 2: Set Rng = Worksheets("sheet1").Range("A2")
Do While Len(Rng) > 0
Do
n = n + Rng.Offset(, 2).Value
Set Rng = Rng.Offset(1)
Loop While Rng.Row = 2 Or Rng.Value = Rng.Offset(-1).Value And Rng.Offset(-1, 1).Value = Rng.Offset(-1, 1).Value
Cells(j, "E") = Rng.Offset(-1).Value
Cells(j, "F") = Rng.Offset(-1, 1).Value
Cells(j, "G") = n
n = 0: j = j + 1
Loop
End Sub
答案 1 :(得分:0)
尝试一下
Sub Test()
Dim a, ws As Worksheet, dic As Object, s As String, i As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
Set dic = CreateObject("scripting.dictionary")
a = ws.Range("A2:C" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Value
For i = LBound(a, 1) To UBound(a, 1)
s = a(i, 1) & vbTab & a(i, 2)
If Not dic.Exists(s) Then dic(s) = Array(, , 0)
dic(s) = Array(a(i, 1), a(i, 2), dic(s)(2) + a(i, 3))
Next i
ws.Range("E2").Resize(dic.Count, 3).Value = Application.Transpose(Application.Transpose(dic.items))
End Sub