- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
回復 5# duck_simon
今天修改複習了一下,請前輩參考
執行前:
執行結果:
Option Explicit
Sub TEST_1()
Dim Brr, A, B, V, Y, Z, xR As Range, i&, j&, N&
'↑宣告變數:(Brr,A,B,V,Y,Z)是通用型變數,xR是儲存格變數,(i,j,N)是長整數變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y這通用型變數是字典
Set Z = CreateObject("Scripting.Dictionary")
'↑令Z這通用型變數是字典
Brr = [A1:BH14]
'↑令Brr這通用型變數是 二維陣列!以[A1:BH14]儲存格值帶入
[AV3:BH14].Interior.ColorIndex = xlNone
'↑令[AV3:BH14]儲存格底色是無色
[K20] = ""
'↑令[K20]儲存格值是空字元
For Each xR In [N18:S18]
'↑設迴圈令xR這儲存格變數是 [N18:S18]裡的一儲存格
Z(xR & "") = xR.Interior.ColorIndex
'↑令xR變數 連接空字元組合的字串當Key,Item是xR變數的底色,納入Z字典
V = "/" & xR & "/" & V
'↑令V這通用型變數是 "/" 連接 xR變數 再連接 "/" 最後連接 V變數自身
Next
For i = 3 To UBound(Brr)
'↑設順迴圈!i從3 到Brr陣列縱向最大索引列號
Set Y(i) = CreateObject("Scripting.Dictionary")
'↑令i變數當Key,Item是字典,納入Y字典裡
For j = 22 To UBound(Brr, 2)
'↑設順迴圈!j從22 到Brr陣列橫向最大索引欄號
If Val(Brr(i, j)) > 0 Then
'↑如果以Val()轉化 i列j欄的Brr陣列值大於0 ?
Set Y(i)(Brr(i, j) & "") = Cells(i, j)
'↑令i列j欄的Brr陣列值連接空字元的新字串當Key,
'Item是i列j欄儲存格,納入i變數的Y字典
End If
Next
Next
For Each A In Y.Keys
'↑設外逐項迴圈!令A這通用型變數是Y字典的其中一個Key
For Each B In Y(A).Keys
'↑設內逐項迴圈!令B這通用型變數是A變數Y字典的其中一個Key
If InStr(V, "/" & B & "/") Then
'↑如果V變數裡有 包含(B變數前後連接 "/"的新字串)??
N = N + 1
'↑If條件成立就令N這長整數變數累加1
If N >= 3 Then [K20] = "X": Exit For
'↑如果N變數 >=3!就令[K20]儲存格值是"X"!然後跳出內迴圈
End If
Next
If N >= 3 Then
'↑如果N變數 >=3 ?
For Each B In Y(A).Keys
'↑設內逐項迴圈!令B變數是A變數Y字典的其中一個Key
Y(A)(B).Interior.ColorIndex = Z(B)
'↑令B變數查A變數Y字典的Item底色是 以B變數查Z字典回傳值
Next
End If
N = 0
Next
Set Y = Nothing: Set Z = Nothing: Set Brr = Nothing
'↑令釋放變數
End Sub |
|
發表於 2023-3-7 08:36
| 
