返回列表 上一主題 發帖

請教陣列比對超過3個

回復 19# duck_simon


=IF(OR(MMULT(1-ISERROR(RANK(B4:J12,B20:F20)),ROW($1:$9)^0)>2),"X","")

B~J欄共9欄...對應Row(1:9)..9行

TOP

回復 20# Andy2483


    以下是濾重複後比對超過3個的VBA方法,請各位前輩指導

Option Explicit
Sub TEST_2()
Call 亂數重置

Dim Brr, xR As Range, i&, j&, A, B, V, Y
Set Y = CreateObject("Scripting.Dictionary")
Brr = [A1:J12]: [A1:J12].Interior.ColorIndex = xlNone: [K20] = ""
For Each xR In [B20:F20]
   Y(xR & "/") = xR.Interior.ColorIndex: V = V & "/" & xR
Next
For i = 4 To UBound(Brr)
i01:
   For j = 2 To UBound(Brr, 2)
      If B = 1 Then
         Cells(i, j).Interior.ColorIndex = Y(Cells(i, j) & "/")
         ElseIf InStr(V & "/", "/" & Brr(i, j) & "/") And Y(Brr(i, j) & "/" & i) = "" Then
            If Y("|") < 2 Then
               Y("|") = Y("|") + 1
               Else
                  B = 1: [K20] = "X": GoTo i01
            End If
            Y(Brr(i, j) & "/" & i) = 1
      End If
   Next
   Y("|") = 0: B = 0
Next
Set Y = Nothing: Set Brr = Nothing
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 22# Andy2483


    謝謝論壇,謝謝各位前輩
後學延伸學習,不使用字典濾重複的方案,請各位前輩指導

Option Explicit
Sub TEST_2()
Call 亂數重置

Dim Brr, xR As Range, i&, j&, A(49), B, V
Brr = [A1:J12]: [A1:J12].Interior.ColorIndex = xlNone: [K20] = ""
For Each xR In [B20:F20]
   A(Val(xR)) = xR.Interior.ColorIndex: V = V & "/" & xR
Next
For i = 4 To UBound(Brr)
i01: A(0) = "||"
   For j = 2 To UBound(Brr, 2)
      If B = 1 Then
         Cells(i, j).Interior.ColorIndex = A(Cells(i, j))
         ElseIf InStr(V & "/", "/" & Brr(i, j) & "/") And InStr(A(0), "/" & Brr(i, j) & "/") = 0 Then
            If Val(A(0)) < 2 Then
               A(0) = Val(A(0)) + 1 & "|" & Mid(A(0), 3)
               Else
                  B = 1: [K20] = "X": GoTo i01
            End If
            A(0) = A(0) & "/" & Brr(i, j) & "/"
      End If
   Next
   B = 0
Next
Set Brr = Nothing: Erase A
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復  duck_simon


=IF(OR(MMULT(1-ISERROR(RANK(B4:J12,B20:F20)),ROW($19)^0)>2),"X","")

B~J欄 ...
准提部林 發表於 2023-3-8 12:20



感謝大大  了解  辛苦了!

TOP

回復  Andy2483


    謝謝論壇,謝謝各位前輩
後學延伸學習,不使用字典濾重複的方案,請各位前輩指導
...
Andy2483 發表於 2023-3-8 15:47



    收藏了  將來用上    謝謝!

TOP

回復 25# duck_simon


    謝謝論壇,謝謝各位前輩
再次謝謝前輩發表此主題與範例
後學複習昨天的習題心得註解如下,請參考
試按了幾百次最多4個比對上,沒偏財運

Option Explicit
Sub TEST_2()
Call 亂數重置
'↑執行(亂數重置)副程式

Dim Brr, B, V, Y, xR As Range, i&, j&
'↑宣告變數:(Brr,B,V,Y)是通用型變數,xR是儲存格變數,(i,j)是長整數變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y這通用型變數是 字典
Brr = [A1:J12]: [A1:J12].Interior.ColorIndex = xlNone: [K20] = ""
'↑令Brr這通用型變數是 二維陣列!以[A1:J12]儲存格值倒入,
'令[A1:J12]儲存格底色是 無色 :[K20]儲存格值是空字元

For Each xR In [B20:F20]
'↑設逐項迴圈!令xR這儲存格變數是 [B20:F20]儲存格的一格
   Y(xR & "/") = xR.Interior.ColorIndex: V = V & "/" & xR
   '↑令xR變數連接 "/"的新字串為Key,Item是 xR變數的底色 納入Y字典,
   '令V這通用型變數是 自身連接 "/"再連接 xR變數的新字串

Next
For i = 4 To UBound(Brr)
'↑設順迴圈!i從4 到Brr陣列縱向最大索引列號
i01:
   For j = 2 To UBound(Brr, 2)
   '↑設順迴圈!j從2 到Brr陣列橫向最大索引欄號
      If B = 1 Then
      '↑如果B這通用型變數是 1??
         Cells(i, j).Interior.ColorIndex = Y(Cells(i, j) & "/")
         '↑令i迴圈列j迴圈欄的儲存格底色是:
         '以i迴圈列j迴圈欄的儲存格值連接"/"的新字串為Key查Y字典的回傳值

         ElseIf InStr(V & "/", "/" & Brr(i, j) & "/") Then
         '↑否則如果V變數連接 "/"的新字串裡包含了,
         '包含了(i迴圈列j迴圈欄Brr陣列值在前後各連接"/"的新字串)

            If Y("|") < 2 Then
            '↑如果以 "|"查Y字典回傳Item值 < 2 ?
               Y("|") = Y("|") + 1
               '↑令Y字典裡"|"為key的item值累加 1
               Else
                  B = 1: [K20] = "X": GoTo i01
                  '↑令B變數是 1:令[K20]儲存格值是 "X",
                  '最後跳到 i01標示位置繼續執行

            End If
      End If
   Next
   Y("|") = 0: B = 0
   '↑令Y字典裡"|"為key的item值是 0:令B變數是 0
Next
Set Y = Nothing: Set Brr = Nothing
'↑令釋放變數
End Sub
========================================
Sub 亂數重置()
With [B4:J12]
'↑以下是關於[B4:J12]儲存格的程序
   .Value = "=INT(MOD(RAND()*1000,49))+1"
   '↑令格值是公式:
   '0到1之間的亂數1000倍除以49的餘數去除小數後 +1

   .Value = .Value
   '↑令格裡的公式轉化為值
End With
End Sub
========================================
Option Explicit
Sub TEST_2_字典濾重複()
Call 亂數重置
'↑令執行(亂數重置)副程式

Dim Brr, B, V, Y, xR As Range, i&, j&
'↑宣告變數:(Brr,B,V,Y)是通用型變數,xR是儲存存格變數,(i,j)是長整數變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y這通用型變數是 字典
Brr = [A1:J12]: [A1:J12].Interior.ColorIndex = xlNone: [K20] = ""
'↑令Brr這通用型變數是 二維陣列!以[A1:J12]儲存格值帶入,
'令[A1:J12]儲存格底色是無色,令[K20]儲存格值是 空字元

For Each xR In [B20:F20]
'↑令設逐項迴圈!令xR這儲存格變數是 [B20:F20]儲存格裡的一格
   Y(xR & "/") = xR.Interior.ColorIndex: V = V & "/" & xR
   '↑令xR變數連接"/"的新字串當key,item是xR變數的底色納入Y字典,
   '令V這通用型變數是 自身連接"/"再連接xR變數的新字串

Next
For i = 4 To UBound(Brr)
'↑設順迴圈!i從4 到Brr陣列縱向最大索引列號
i01:
   For j = 2 To UBound(Brr, 2)
   '↑設順迴圈!j從2 到Brr陣列橫向最大索引欄號數
      If B = 1 Then
      '↑如果B這通用型變數是 1?
         Cells(i, j).Interior.ColorIndex = Y(Cells(i, j) & "/")
         '↑令i迴圈列j迴圈欄的儲存格底色是:
         '以i迴圈列j迴圈欄的儲存格值連接"/"的新字串為Key查Y字典的回傳值

         ElseIf InStr(V & "/", "/" & Brr(i, j) & "/") And Y(Brr(i, j) & "/" & i) = "" Then
         '↑否則如果V變數連接 "/"的新字串裡包含了,
         '包含了(i迴圈列j迴圈欄Brr陣列值在前後各連接"/"的新字串)
         '而且 i迴圈列j迴圈欄Brr陣列值連接"/"再連接i變數的新字串查Y字典回傳值是空字元?

            If Y("|") < 2 Then
            '↑如果以 "|"查Y字典回傳Item值 < 2 ?
               Y("|") = Y("|") + 1
               '↑令Y字典裡"|"為key的item值累加 1
               Else
                  B = 1: [K20] = "X": GoTo i01
                  '↑令B變數是 1:令[K20]儲存格值是 "X",
                  '最後跳到 i01標示位置繼續執行

            End If
            Y(Brr(i, j) & "/" & i) = 1
            '↑令i迴圈列j迴圈欄Brr陣列值連接"/"再連接i變數的新字串,
            '這新字串為Y字典key的item值是 1

      End If
   Next
   Y("|") = 0: B = 0
   '↑令Y字典裡"|"為key的item值是 0:令B變數是 0
Next
Set Y = Nothing: Set Brr = Nothing
'↑令釋放變數
End Sub
========================================
Option Explicit
Sub TEST_2_Instr濾重複()
Call 亂數重置
'↑令執行(亂數重置)副程式

Dim Brr, B, V, xR As Range, i&, j&, A(49)
'↑宣告變數:(Brr,B,V,)是通用型變數,xR是儲存存格變數,(i,j)是長整數變數,A是一維陣列(0~49)
Brr = [A1:J12]: [A1:J12].Interior.ColorIndex = xlNone: [K20] = ""
'↑令Brr這通用型變數是 二維陣列!以[A1:J12]儲存格值帶入,
'令[A1:J12]儲存格底色是無色,令[K20]儲存格值是 空字元

For Each xR In [B20:F20]
'↑令設逐項迴圈!令xR這儲存格變數是 [B20:F20]儲存格裡的一格
   A(Val(xR)) = xR.Interior.ColorIndex: V = V & "/" & xR
   '↑令xR變數轉化為數字為索引號的A陣列值是xR變數的底色號
   '令V這通用型變數是 自身連接"/"再連接xR變數的新字串

Next
For i = 4 To UBound(Brr)
'↑設順迴圈!i從4 到Brr陣列縱向最大索引列號
i01: A(0) = "||"
   For j = 2 To UBound(Brr, 2)
   '↑設順迴圈!j從2 到Brr陣列橫向最大索引欄號數
      If B = 1 Then
      '↑如果B這通用型變數是 1?
         Cells(i, j).Interior.ColorIndex = A(Cells(i, j))
         '↑令i迴圈列j迴圈欄的儲存格底色是:
         '以i迴圈列j迴圈欄的儲存格值為索引號的 A陣列值

         ElseIf InStr(V & "/", "/" & Brr(i, j) & "/") And InStr(A(0), "/" & Brr(i, j) & "/") = 0 Then
         '↑否則如果V變數連接 "/"的新字串裡包含了,
         '包含了(i迴圈列j迴圈欄Brr陣列值在前後各連接"/"的新字串)
         '而且 i迴圈列j迴圈欄Brr陣列值前後各連接"/"的新字串在 0索引號A陣列裡有被包含?

            If Val(A(0)) < 2 Then
            '↑如果0索引號A陣列值轉化為數值後 < 2?
               A(0) = Val(A(0)) + 1 & "|" & Mid(A(0), 3)
               '↑令0索引號A陣列值是 自身轉化為數值+1 連接"|" 再連接自身從第3字開始之後全部字串,
               '組合成的新字串

               Else
                  B = 1: [K20] = "X": GoTo i01
                  '↑令B變數是 1:令[K20]儲存格值是 "X",
                  '最後跳到 i01標示位置繼續執行

            End If
            A(0) = A(0) & "/" & Brr(i, j) & "/"
            '↑令0索引號A陣列值是 自身連接"/" 再連接i迴圈列j迴圈欄Brr陣列值,
            '最後連接"/"的新字串

      End If
   Next
   B = 0
   '↑令令B變數是 0
Next
Set Brr = Nothing: Erase A
'↑令釋放變數
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

        靜思自在 : 【行善要及時】行善要及時,功德要持續。如燒開水一般,未燒開之前千萬不要停熄火候,否則重來就太費事了。
返回列表 上一主題