|
|
Sub ColorCount()
Dim rngCell As Range, rngUnion As Range, i%
For i = 2 To Range("a" & Rows.Count).End(xlUp).Row
For Each rngCell In Cells(i, 1).Resize(1, 3)
If rngCell.Interior.Color = 255 Then
If rngUnion Is Nothing Then
Set rngUnion = rngCell
Else
Set rngUnion = Application.Union(rngUnion, rngCell)
End If
End If
Next rngCell
If Not rngUnion Is Nothing Then Cells(i, 4) = rngUnion.Columns.Count
Set rngCell = Nothing
Set rngUnion = Nothing
For Each rngCell In Cells(i, 1).Resize(1, 3)
If rngCell.Interior.Color = 10498160 Then
If rngUnion Is Nothing Then
Set rngUnion = rngCell
Else
Set rngUnion = Application.Union(rngUnion, rngCell)
End If
End If
Next rngCell
If Not rngUnion Is Nothing Then Cells(i, 5) = rngUnion.Columns.Count
Set rngCell = Nothing
Set rngUnion = Nothing
For Each rngCell In Cells(i, 1).Resize(1, 3)
If rngCell.Interior.Color = 5296274 Then
If rngUnion Is Nothing Then
Set rngUnion = rngCell
Else
Set rngUnion = Application.Union(rngUnion, rngCell)
End If
End If
Next rngCell
If Not rngUnion Is Nothing Then Cells(i, 6) = rngUnion.Columns.Count
Set rngCell = Nothing
Set rngUnion = Nothing
Next i
End Sub
颜色计数.zip
(17.76 KB, 下载次数: 82)
|
|
