A列编号B列名称C列规格对应行相同合并在对应列D列数量对应相加用VBA怎样编写

Question

A列编号B列名称C列规格对应行相同合并在对应列D列数量对应相加用VBA怎样编写

Answer 1

这个有些复杂,没分数吗?请增加悬赏分!
Private Sub CommandButton1_Click()
   If MsgBox("警告!" & vbCrLf & _
           "过程不可逆转,请做好备份!"& vbCrLf & vbCrLf & _
           "开始执行程序吗?",vbInformation + vbOKCancel, _
           "警告!")<> vbOK Then Exit Sub
   Dim a, d, s, r, col, i, j, tmp
   Dim c As Range, rg As Range
   Set d = CreateObject("Scripting.Dictionary")
   Set c = Cells(1, 1).Resize(1, 4) '标题行位置
    r= Cells(65536, c.Column).End(xlUp).Row
   If r <= c.Row Then
       MsgBox "无数据!": Exit Sub
   End If
    a= c.Resize(r - c.Row + 1)
   For i = LBound(a) + 1 To UBound(a)
       tmp = Join(Array(a(i, 1), a(i, 2), a(i, 3)), "|")
       If d.Exists(tmp) Then
           d(tmp) = d(tmp) + a(i, 4)
       Else
           d(tmp) = a(i, 4)
       End If
   Next
    s= d.keys
   ReDim a(LBound(s) To UBound(s), 0 To 3)
   For i = LBound(s) To UBound(s)
       tmp = Split(s(i), "|")
       For j = LBound(tmp) To UBound(tmp)
           a(i, j) = tmp(j)
       Next
       a(i, 3) = d(s(i))
   Next
   With c.Offset(1)
       .Resize(r - c.Row).ClearContents
       .Resize(d.Count) = a
   End With
End Sub