|
本帖最后由 zt1066815277 于 2022-6-26 10:17 编辑
学习中,留个记号
Sub test()
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
For i = 2 To 13
If d.exists(Cells(i, 2).Value & "," & Cells(i, 4).Value) Then
d(Cells(i, 2).Value & "," & Cells(i, 4).Value) = d(Cells(i, 2).Value & "," & Cells(i, 4).Value) & "/" & Cells(i, 3)
Else
d(Cells(i, 2).Value & "," & Cells(i, 4).Value) = Cells(i, 3)
End If
Next
ReDim arr(1 To d.Count, 1 To 4)
For i = 0 To d.Count - 1
kk = kk + 1
dd = d.items
If InStr(d.items()(i), "/") <> 0 Then
brr = Split(d.items()(i), "/")
For j = 0 To UBound(brr)
d1(brr(j)) = d1(brr(j)) + 1
Next
For k = 0 To UBound(d1.keys)
Sum1 = Sum1 * 1 + brr(k) * d1.items()(k) * 1
Sum = Sum & "+" & brr(k) & "*" & d1.items()(k)
Next
Sum = Right(Sum, Len(Sum) - 1)
arr(kk, 1) = Split(d.keys()(i), ",")(0)
arr(kk, 2) = Sum1
arr(kk, 3) = Sum
arr(kk, 4) = Split(d.keys()(i), ",")(1)
Else
arr(kk, 1) = Split(d.keys()(i), ",")(0)
arr(kk, 2) = d.items()(i)
arr(kk, 3) = ""
arr(kk, 4) = Split(d.keys()(i), ",")(1)
End If
Sum1 = 0
Sum = ""
d1.RemoveAll
Next
Range("i2").Resize(UBound(arr), 4) = arr
End Sub
|
|