准提部林

Dim R(1 To 3) As Range, x%, z%, i%, U%
RW = Array(.[T5], .[R6], b(1, -1))
For x = 1 To 4
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 R(i) Is Nothing Then U = 1: Exit For
　　　　'If R(i).Column <> R(1).Column Then U = 1: Exit For '同欄
　　Next i
　　If U = 0 Then
　　　　For i = 1 To 3: R(i).Interior.ColorIndex = Array(4, 6, 8)(i - 1): Next
　　End If
Next z
Next x

准提部林

回復 3# Airman

４９列的〔３９〕，為何只０６符合，４９不算？
６４列的〔５４〕，為何只０６符合，０８．４９不算？

准提部林

須多兩道程式:
１．全部檢測一次，收集符合者納入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

准提部林

回復 8# Airman


Set R(i) = .[J6:P6].Cells(RW(i - 1) - x + 1, z)