請測試看看，謝謝
Sub test()
Dim Arr, xU, i%, j%
Arr = Range([a1], [ay65536].End(3))
'Cells.Interior.ColorIndex = 0
Set xU = [a1]
For j = 24 To 27: For i = 2 To UBound(Arr)
If IsNumeric(Arr(i, j)) Then
If Val(Arr(i, j)) < 0 Then
If j = 24 Then Set xU = Union(Cells(i, j), Cells(i, j - 19), Cells(i, j - 5), Cells(i, j + 6), Cells(i, j + 15), xU)
If j = 25 Then Set xU = Union(Cells(i, j), Cells(i, j - 16), Cells(i, j - 5), Cells(i, j + 6), Cells(i, j + 18), xU)
If j = 26 Then Set xU = Union(Cells(i, j), Cells(i, j - 13), Cells(i, j - 5), Cells(i, j + 6), Cells(i, j + 21), xU)
If j = 27 Then Set xU = Union(Cells(i, j), Cells(i, j - 10), Cells(i, j - 5), Cells(i, j + 6), Cells(i, j + 24), xU)
End If
End If
Next i: Next j
xU.Interior.ColorIndex = 3
[a1].Interior.ColorIndex = xlNone
End Sub作者: 准提部林 時間: 2021-10-29 10:29
Sub TEST_A1()
Dim R&, Rng(1 To 4) As Range, i%
R = ActiveSheet.UsedRange.Rows.Count - 1
Application.ScreenUpdating = False
For i = 1 To 4
Set Rng(1) = [e2].Cells(1, i * 4 - 3).Resize(R)
Set Rng(2) = [s2].Cells(1, i).Resize(R)
Set Rng(3) = [x2].Cells(1, i).Resize(R)
Set Rng(4) = [am2].Cells(1, i * 4 - 3).Resize(R)
With Union(Rng(1), Rng(2), Rng(3), Rng(4))
.Item(1).Select
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=1/" & Array("$X2", "$Y2", "$Z2", "$AA2")(i - 1)
.FormatConditions(1).Interior.ColorIndex = 3
End With
Next i
[e1].Select
End Sub作者: jeff5424 時間: 2021-10-30 00:41
