各位前輩好
今天請教底色與字色的問題
1.由於較新版excel的底色字色設定比較多樣性!希望能自動讓底色字色設定自動調整反差易於識別
2.以下以 Interior_ColorIndex 方式 表達題意!
3.請教各位前輩有什麼方式可以 Interior_Color的方式設定底色方式,也可以自動讓底色字色設定自動調整反差?
因為顏色號種類太多了! 有什麼規則可循嗎?
 20221110.zip (56.09 KB)
原始資料:
Interior_ColorIndex 方式結果:
Interior_Color方式設定底色 .深底色的字還沒變白色:
Option Explicit
Sub Interior_ColorIndex()
Dim Arr, R&, C&, Sh, Brr, Crr, i&, x&, Y, T, Zn, N
Set Y = CreateObject("Scripting.Dictionary")
T = Timer
Set Sh = Sheets("操作表")
R = Sh.UsedRange.EntireRow.Rows.Count
C = Sh.UsedRange.EntireColumn.Columns.Count
Arr = Range(Sh.[A1], Sh.Cells(R, C))
For i = 1 To R
Zn = Arr(i, 1)
If Y.Exists(Zn) = 0 Then
N = N + 1
Y(Zn) = N
End If
Sh.Cells(i, 1).Interior.ColorIndex = Y(Zn)
If InStr("/1/3/5/9/10/11/12/13/18/21/23/25/26/29/30/31/32/41/47/49/51/52/53/54/55/56/", "/" & Y(Zn) & "/") Then
Sh.Cells(i, 1).Font.ColorIndex = 2
End If
Next
End Sub
Option Explicit
Sub Interior_Color()
Dim Arr, R&, C&, Sh, Brr, Crr, i&, x&, Y, T, Zn, N
Set Y = CreateObject("Scripting.Dictionary")
T = Timer
Set Sh = Sheets("操作表")
R = Sh.UsedRange.EntireRow.Rows.Count
C = Sh.UsedRange.EntireColumn.Columns.Count
Arr = Range(Sh.[A1], Sh.Cells(R, C))
For i = 1 To R
Zn = Arr(i, 1)
If Y.Exists(Zn) = 0 Then
N = N + 100000
Y(Zn) = N
End If
Sh.Cells(i, 1).Interior.Color = Y(Zn)
Next
End Sub |
發表於 2022-11-10 08:48
| 
