|
Sub 按钮1_Click()
Set d = CreateObject("scripting.dictionary")
Set hz = Sheets("汇总")
For Each sh In Sheets
If sh.Name <> "汇总" Then
arr = sh.[a1].CurrentRegion
For j = 2 To UBound(arr)
If Len(arr(j, 1)) > 0 Then
d(arr(j, 1)) = d(arr(j, 1)) & Trim(arr(j, 2))
End If
Next j
End If
Next sh
brr = d.items
arr = hz.[a2].Resize(d.Count, 3)
Application.ScreenUpdating = False
For j = 1 To d.Count
arr(j, 1) = d.keys()(j - 1)
arr(j, 2) = Len(Replace(d.items()(j - 1), "否", ""))
arr(j, 3) = Len(d.items()(j - 1)) - arr(j, 2)
Next j
hz.[a2].Resize(UBound(arr), 3) = arr
Application.ScreenUpdating = True
End Sub
|
评分
-
1
查看全部评分
-
|