答案 0 :(得分:0)
我在A20:C29范围内输入了您的样本数据。然后,我用下面的公式创建了一个帮助器列。
=SUMIFS($B$20:$B$29,$A$20:$A$29,$A20,$C$20:$C$29,$C20)
将帮助程序列复制到“剪贴板”和“ PasteSpecial”>“值”(以结果值替换公式)。
然后将帮助程序列剪切/粘贴到B列,并基于A列和C列删除重复项。
答案 1 :(得分:0)
尝试:
Option Explicit
Sub test()
Dim LastrowA As Long, LastrowF, i As Long, y As Long, j As Long
Dim Ad_Desc As String
Dim Total As Double
Dim arr As Variant
Dim Exist As Boolean
With ThisWorkbook.Worksheets("Sheet1")
LastrowA = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To LastrowA
Ad_Desc = .Range("A" & i).Value & "_" & .Range("C" & i).Value
Total = .Range("B" & i).Value
If i = 2 Then
For y = i + 1 To LastrowA
If .Range("A" & y).Value & "_" & .Range("C" & y).Value = Ad_Desc Then
Total = Total + .Range("B" & y).Value
End If
Next y
LastrowF = .Cells(.Rows.Count, "F").End(xlUp).Row
.Range("F" & LastrowF + 1).Value = .Range("A" & i).Value
.Range("G" & LastrowF + 1).Value = Total
.Range("H" & LastrowF + 1).Value = .Range("C" & i).Value
arr = Array(Ad_Desc)
Else
Exist = False
For j = LBound(arr) To UBound(arr)
If arr(j) = Ad_Desc Then
Exist = True
Exit For
Else
Exist = False
End If
Next j
If Exist = False Then
For y = i + 1 To LastrowA
If .Range("A" & y).Value & "_" & .Range("C" & y).Value = Ad_Desc Then
Total = Total + .Range("B" & y).Value
End If
Next y
LastrowF = .Cells(.Rows.Count, "F").End(xlUp).Row
.Range("F" & LastrowF + 1).Value = .Range("A" & i).Value
.Range("G" & LastrowF + 1).Value = Total
.Range("H" & LastrowF + 1).Value = .Range("C" & i).Value
ReDim Preserve arr(0 To UBound(arr) + 1)
arr(UBound(arr)) = Ad_Desc
End If
End If
Next i
End With
End Sub
结果: