|
Sub 按钮1_Click()
Set d = CreateObject("scripting.dictionary")
Set dd = CreateObject("scripting.dictionary")
arr = [a1:b11]
With CreateObject("vbscript.regexp")
.Pattern = "[一-龥]+"
For j = 2 To UBound(arr)
If .test(arr(j, 1)) Then
str1 = .Execute(arr(j, 1))(0)
If Not d.exists(str1) Then
Set d(str1) = CreateObject("scripting.dictionary")
End If
d(str1)(Val(arr(j, 2))) = d(str1)(Val(arr(j, 2))) & "," & j
dd(str1) = dd(str1) + Val(arr(j, 2))
End If
Next j
End With
Cells(2, 11) = WorksheetFunction.Sum(dd.items)
r = 2
l1:
If dd.Count <> 0 Then
m = WorksheetFunction.Large(dd.items, 1)
For j = dd.Count - 1 To 0 Step -1
If dd.items()(j) = m Then
k = dd.keys()(j)
r = r + 1
Cells(r, 10) = k & "合计"
Cells(r, 11) = m
For i = 1 To d(k).Count
n = WorksheetFunction.Large(d(k).keys, i)
brr = Split(d(k)(n), ",")
For Z = 1 To UBound(brr)
r = r + 1
rx = Val(brr(Z))
Cells(r, 10) = arr(rx, 1)
Cells(r, 11) = arr(rx, 2)
Next Z
Next i
dd.Remove dd.keys()(j)
End If
Next j
GoTo l1
End If
End Sub
|
评分
-
2
查看全部评分
-
|