|
代码如下。。。
Sub test()
Dim wb As Workbook, sht As Worksheet
Set wb = ThisWorkbook
Set sht = wb.Sheets("sheet1")
With sht
arr = .UsedRange
Set d = CreateObject("scripting.dictionary")
For i = 30 To 32
x = .Cells(i, 2).Interior.Color
d(x) = i - 29
Next
ReDim brr(1 To d.Count, 1 To 1)
For i = 4 To UBound(arr) - 3
For j = 3 To UBound(arr, 2)
y = .Cells(i, j).Interior.Color
If d.exists(y) Then
brr(d(y), 1) = brr(d(y), 1) + arr(i, j)
End If
Next
Next
.Cells(30, 3).Resize(UBound(brr)) = brr
End With
Beep
Set d = Nothing
End Sub
|
|