|
没做测试,你自己检验一下吧- Private Sub CommandButton1_Click()
- Dim arr, i&, j&, r&, c&, YMax&, RMax&, GMax&
- r = [d3].CurrentRegion.Rows.Count
- c = [d3].CurrentRegion.Columns.Count
- [j18].Resize(r, 6).ClearContents
- ReDim arr(1 To r, 1 To 6)
- For i = 1 To r
- For j = 1 To c
- If Cells(i + 2, j + 3).Interior.ColorIndex = 6 Then arr(i, 1) = arr(i, 1) + 1: arr(i, 2) = Application.Max(arr(i, 2), j - YMax - 1): YMax = j
- If Cells(i + 2, j + 3).Interior.ColorIndex = 3 Then arr(i, 5) = arr(i, 5) + 1: arr(i, 6) = Application.Max(arr(i, 6), j - RMax - 1): RMax = j
- If Cells(i + 2, j + 3).Interior.ColorIndex = 10 Then arr(i, 3) = arr(i, 3) + 1: arr(i, 4) = Application.Max(arr(i, 4), j - GMax - 1): GMax = j
- Next j
- YMax = 0: RMax = 0: GMax = 0
- Next i
- [j18].Resize(r, 6) = arr
- End Sub
复制代码 |
|