Public Sub DealWith()
Dim arr As Variant, brr As Variant, crr As Variant, i As Integer, k As Integer, s As Integer, dic As Object
'清理sheet1中的数据
Sheet1.Range("A1").CurrentRegion.ClearContents
'获取工作表1中的数据
arr = 工作表5.Range("A1").CurrentRegion.Value
'创建字典
Set dic = CreateObject("Scripting.Dictionary")
'利用字典删除重复项,同时累加求和
For i = 1 To UBound(arr, 1)
dic(arr(i, 1) & "," & arr(i, 2) & "," & arr(i, 3) & "," & arr(i, 4)) = dic(arr(i, 1) & "," & arr(i, 2) & "," & arr(i, 3) & "," & arr(i, 4)) + arr(i, 5)
Next i
'将删除重复项后的内容赋值到数组变量brr
brr = Application.WorksheetFunction.Transpose(dic.Keys)
'利用循环及Split函数重新构建一个数组(单号、L、W、H)并赋值给数组变量crr
ReDim crr(1 To dic.Count + 1, 1 To 4)
For k = 1 To UBound(brr, 1)
For s = 1 To 4
crr(k, s) = Split(brr(k, 1), ",")(s - 1)
Next s
Next k
'将结果输出到工作表sheet1中
With Sheet1.Range("A1")
.Resize(UBound(crr, 1), UBound(crr, 2)).Value = crr
.Offset(0, 4).Resize(dic.Count, 1).Value = Application.WorksheetFunction.Transpose(dic.Items)
End With
'调整工作表sheet1的列宽/居中
With Sheet1.Columns("A:E")
.AutoFit
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End Sub |