返回列表 上一主題 發帖

[發問] 設定格式化的條件問題

[發問] 設定格式化的條件問題

請教各位高手大大

設定格式化的條件問題
X,Y,Z,AA   欄位數子不等於0,指定欄位底填滿紅色

(橙色欄位)-->X欄位數子不等於0,指定E,S,AD,AM欄位底填滿紅色
(黃色欄位)-->Y欄位數子不等於0,指定I,T,AE,AQ欄位底填滿紅色
(淺綠色欄位)-->Z欄位數子不等於0,指定M,U,AF,AU欄位底填滿紅色
(淺橙色欄位)-->AA欄位數子不等於0,指定Q,V,AG,AY欄位底填滿紅色

案例:
1.AA2欄位數子不等於0,指定位置Q2,V2,AG2,AY2欄位底填滿紅色
2.AA5欄位數子不等於0,指定位置Q5,V5,AG5,AY5欄位底填滿紅色
3.Z6欄位數子不等於0,指定位置M6,U6,AF6,AU6欄位底填滿紅色
4.Z9欄位數子不等於0,指定位置M9,U9,AF9,AU9欄位底填滿紅色
5.Y10欄位數子不等於0,指定位置I10,T10,AE10,AQ10欄位底填滿紅色
6.X11欄位數子不等於0,指定位置E11,S11,AD11,AM11欄位底填滿紅色

設定格式化的條件問題.rar (34.33 KB)

回復 1# jeff5424

請測試看看,謝謝
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

TOP

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

TOP

回復 3# 准提部林


    感謝版主大大
經測試可正常使用

TOP

回復 2# samwang
感謝samwang大大
經測試可正常使用

TOP

        靜思自在 : 虛空有盡.我願無窮,發願容易行願難。
返回列表 上一主題