返回列表下一主題上一主題發帖

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

jeff5424

中學生 Rank: 2

帖子: 84
主題: 34
精華: 0
積分: 133
點名: 0
作業系統: xp
軟體版本: 2003
閱讀權限: 20
性別: 男
來自: 斗六
註冊時間: 2010-8-12
最後登錄: 2026-5-13

論壇贊助勳章

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2021-10-28 23:03 | 只看該作者

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

請教各位高手大大

設定格式化的條件問題
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)

樓主熱帖

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2026-5-26

2^#

發表於 2021-10-29 08:01 | 只看該作者

回復 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

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2848
主題: 10
精華: 0
積分: 2903
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2026-7-25

3^#

發表於 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

TOP

jeff5424