- 帖子
- 2834
- 主題
- 10
- 精華
- 0
- 積分
- 2890
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-11-23
|
6#
發表於 2015-12-30 17:29
| 只看該作者
須多兩道程式:
１．全部檢測一次，收集符合者納入union聯集區
２．逐一聯集區取出儲存格填色
Dim R(1 To 3) As Range, UR(1 To 3) As Range, x%, z%, i%, U%
RW = Array(b(1, -1), .[T5], .[R6])
For x = 1 To 4
For i = 1 To 3: Set UR(i) = Nothing: Next
For z = 1 To 7
Set R(1) = .[J6].Cells(RW(0) - x + 1, z): U = 0
For i = 2 To 3
Set R(i) = Nothing
Set R(i) = .[J6:P6].Offset(RW(i - 1) - x, 0).Find(R(1), Lookat:=xlWhole) '不同欄
If Not R(i) Is Nothing Then U = U + i '不同欄
'Set R(i) = .[J6:P6].Cells(RW(i - 1) - x, z) '同欄
'If R(i) = R(1) Then U = U + i '同欄
Next i
If U = 2 Then Set UR(1) = Nothing: Exit For
If U = 5 Then
For i = 1 To 3
If UR(i) Is Nothing Then Set UR(i) = R(i) Else Set UR(i) = Union(UR(i), R(i))
Next i
End If
Next z
If Not UR(1) Is Nothing Then
For i = 1 To 3
For Each R(1) In UR(i): R(1).Interior.ColorIndex = Array(8, 4, 6)(i - 1): Next
Next
End If
Next x |
|
發表於 2015-12-30 10:22
| 
