請教陣列比對超過3個

duck_simon

請教先進高手  陣列比對超過3個 內有詳細說明
陣列比對A.rar (8.29 KB)

下載次數: 10

2023-3-5 20:09

感謝~~~:lol

hcm19522

https://blog.xuite.net/hcm19522/twblog/590748962

Andy2483

回復 1# duck_simon


    謝謝前輩發表此主題與範例
後學練習陣列與字典的解決方案如下,請參考

執行前:

下載 (81.33 KB)

2023-3-6 10:14

執行結果:

下載 (69 KB)

2023-3-6 10:15

Option Explicit
Sub TEST_1()
Dim Brr, xR As Range, i&, j&, N&, A, B, V, Y, Z
Set Y = CreateObject("Scripting.Dictionary")
Set Z = CreateObject("Scripting.Dictionary")
Brr = [A1:J12]: [A1:J12].Interior.ColorIndex = xlNone: [K20] = ""
For Each xR In [B20:F20]
   Z(xR & "") = xR.Interior.ColorIndex: V = "/" & xR & "/" & V
Next
For i = 4 To UBound(Brr)
   Set Y(i) = CreateObject("Scripting.Dictionary")
   For j = 2 To UBound(Brr, 2)
      If Val(Brr(i, j)) > 0 Then
         Set Y(i)(Brr(i, j) & "") = Cells(i, j)
      End If
   Next
Next
For Each A In Y.Keys
   For Each B In Y(A).Keys
      If InStr(V, "/" & B & "/") Then
         N = N + 1
         If N >= 3 Then [K20] = "X": Exit For
      End If
   Next
   If N >= 3 Then
      For Each B In Y(A).Keys
         Y(A)(B).Interior.ColorIndex = Z(B)
      Next
   End If
   N = 0
Next
Set Y = Nothing: Set Z = Nothing: Set Brr = Nothing
End Sub
'==================================
'每列濾重複數字

Andy2483

回復 3# Andy2483

藉此帖練習改為自訂函數

Bingo(資料格, 關鍵字格, 顯示字元,每列符合數量)
K15=Bingo(B4:J12,B20:F20,"X",3)

下載 (78.33 KB)

2023-3-6 13:47

Option Explicit
Function Bingo(資料格 As Range, 關鍵字格 As Range, T$, S%)
Dim Brr, xR As Range, i&, j&, N&, A, B, V, Y
Application.Volatile
Set Y = CreateObject("Scripting.Dictionary")
Brr = 資料格
For Each xR In 關鍵字格
   V = "/" & xR & "/" & V
Next
For i = 1 To UBound(Brr)
   Set Y(i) = CreateObject("Scripting.Dictionary")
   For j = 1 To UBound(Brr, 2)
      If Val(Brr(i, j)) > 0 Then
         Set Y(i)(Brr(i, j) & "") = Cells(i, j)
      End If
   Next
Next
For Each A In Y.Keys
   For Each B In Y(A).Keys
      If InStr(V, "/" & B & "/") Then
         N = N + 1
         If N >= S Then
            Bingo = T
            Set Y = Nothing: Set Brr = Nothing
            Exit Function
         End If
      End If
   Next
   N = 0
Next
Bingo = ""
End Function

duck_simon

感謝二位前輩指導..我代入後..因為格不同產生#VALUE!
IF(OR(MMULT(COUNTIF($N18:$S18,$AV$3:$BH$14),ROW(3:14)^0)>2),"X","")
請教哪裡出問題? 因在下笨拙..是行列高度 嗎?   謝謝

hcm19522

回復 5# duck_simon

表格 手動改自動 :點上面 "公式"-->點右邊 "運算選項"-->點 "自動"
ROW(3:14)改ROW(1:13) 試試
排除N18:S18空格=IF(OR(MMULT(COUNTIF(N18:S18,AV3:BH14)*(AV3:BH14<>""),ROW(1:13)^0)>2),"X","")

Andy2483

回復 5# duck_simon


    今天修改複習了一下,請前輩參考

執行前:

下載 (90.86 KB)

2023-3-7 08:33

執行結果:

下載 (98.04 KB)

2023-3-7 08:34

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

duck_simon

回復 6# hcm19522

回hcm19522 大大:
N18:S18沒空格..且是數值無誤.試了一晚.找不到原因我嘗試使用輔助欄  或改為統計數字..謝謝先進!....

duck_simon

回復 7# Andy2483


    大大對于VB 非常深入..惟小的連毛都不懂..見笑了..我還是收藏.拿來用上.非常感謝!.

hcm19522

回復 8# duck_simon


    https://blog.xuite.net/hcm19522/twblog/590684229