Andy2483

¦^´_ 1# duck_simon


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾Ç½m²ß°}¦C»P¦r¨åªº¸Ñ¨M¤è®×¦p¤U,½Ð°Ñ¦Ò

°õ¦æ«e:

¤U¸ü (81.33 KB)

2023-3-6 10:14

°õ¦æµ²ªG:

¤U¸ü (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
'==================================
'¨C¦CÂo­«½Æ¼Æ¦r

Andy2483

¦^´_ 3# Andy2483

ÂǦ¹©«½m²ß§ï¬°¦Û­q¨ç¼Æ

Bingo(¸ê®Æ®æ, ÃöÁä¦r®æ, Åã¥Ü¦r¤¸,¨C¦C²Å¦X¼Æ¶q)
K15=Bingo(B4:J12,B20:F20,"X",3)

¤U¸ü (78.33 KB)

2023-3-6 13:47

Option Explicit
Function Bingo(¸ê®Æ®æ As Range, ÃöÁä¦r®æ 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 ÃöÁä¦r®æ
   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

Andy2483

¦^´_ 5# duck_simon


    ¤µ¤Ñ­×§ï½Æ²ß¤F¤@¤U,½Ð«e½ú°Ñ¦Ò

°õ¦æ«e:

¤U¸ü (90.86 KB)

2023-3-7 08:33

°õ¦æµ²ªG:

¤U¸ü (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&
'¡ô«Å§iÅܼÆ:(Brr,A,B,V,Y,Z)¬O³q¥Î«¬ÅܼÆ,xR¬OÀx¦s®æÅܼÆ,(i,j,N)¬Oªø¾ã¼ÆÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY³o³q¥Î«¬ÅܼƬO¦r¨å
Set Z = CreateObject("Scripting.Dictionary")
'¡ô¥OZ³o³q¥Î«¬ÅܼƬO¦r¨å
Brr = [A1:BH14]
'¡ô¥OBrr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C!¥H[A1:BH14]Àx¦s®æ­È±a¤J
[AV3:BH14].Interior.ColorIndex = xlNone
'¡ô¥O[AV3:BH14]Àx¦s®æ©³¦â¬OµL¦â
[K20] = ""
'¡ô¥O[K20]Àx¦s®æ­È¬OªÅ¦r¤¸
For Each xR In [N18:S18]
'¡ô³]°j°é¥OxR³oÀx¦s®æÅܼƬO [N18:S18]¸Ìªº¤@Àx¦s®æ
   Z(xR & "") = xR.Interior.ColorIndex
   '¡ô¥OxRÅÜ¼Æ ³s±µªÅ¦r¤¸²Õ¦Xªº¦r¦ê·íKey,Item¬OxRÅܼƪº©³¦â,¯Ç¤JZ¦r¨å
   V = "/" & xR & "/" & V
   '¡ô¥OV³o³q¥Î«¬ÅܼƬO "/" ³s±µ xRÅÜ¼Æ ¦A³s±µ "/" ³Ì«á³s±µ VÅܼƦۨ­
Next
For i = 3 To UBound(Brr)
'¡ô³]¶¶°j°é!i±q3 ¨ìBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   Set Y(i) = CreateObject("Scripting.Dictionary")
   '¡ô¥OiÅܼƷíKey,Item¬O¦r¨å,¯Ç¤JY¦r¨å¸Ì
   For j = 22 To UBound(Brr, 2)
   '¡ô³]¶¶°j°é!j±q22 ¨ìBrr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹
      If Val(Brr(i, j)) > 0 Then
      '¡ô¦pªG¥HVal()Âà¤Æ i¦CjÄ檺Brr°}¦C­È¤j©ó0 ?
         Set Y(i)(Brr(i, j) & "") = Cells(i, j)
         '¡ô¥Oi¦CjÄ檺Brr°}¦C­È³s±µªÅ¦r¤¸ªº·s¦r¦ê·íKey,
         'Item¬Oi¦CjÄæÀx¦s®æ,¯Ç¤JiÅܼƪºY¦r¨å
      End If
   Next
Next
For Each A In Y.Keys
'¡ô³]¥~³v¶µ°j°é!¥OA³o³q¥Î«¬ÅܼƬOY¦r¨åªº¨ä¤¤¤@­ÓKey
   For Each B In Y(A).Keys
   '¡ô³]¤º³v¶µ°j°é!¥OB³o³q¥Î«¬ÅܼƬOAÅܼÆY¦r¨åªº¨ä¤¤¤@­ÓKey
      If InStr(V, "/" & B & "/") Then
      '¡ô¦pªGVÅܼƸ̦³ ¥]§t(BÅܼƫe«á³s±µ "/"ªº·s¦r¦ê)??
         N = N + 1
         '¡ôIf±ø¥ó¦¨¥ß´N¥ON³oªø¾ã¼ÆÅܼƲ֥[1
         If N >= 3 Then [K20] = "X": Exit For
         '¡ô¦pªGNÅÜ¼Æ >=3!´N¥O[K20]Àx¦s®æ­È¬O"X"!µM«á¸õ¥X¤º°j°é
      End If
   Next
   If N >= 3 Then
   '¡ô¦pªGNÅÜ¼Æ >=3 ?
      For Each B In Y(A).Keys
      '¡ô³]¤º³v¶µ°j°é!¥OBÅܼƬOAÅܼÆY¦r¨åªº¨ä¤¤¤@­ÓKey
         Y(A)(B).Interior.ColorIndex = Z(B)
         '¡ô¥OBÅܼƬdAÅܼÆY¦r¨åªºItem©³¦â¬O ¥HBÅܼƬdZ¦r¨å¦^¶Ç­È
      Next
   End If
   N = 0
Next
Set Y = Nothing: Set Z = Nothing: Set Brr = Nothing
'¡ô¥OÄÀ©ñÅܼÆ
End Sub

Andy2483

¦^´_ 9# duck_simon


    #5¼Ó½d¨Ò»P#1½d¨Ò¬Û¦P,¬O¤£¬O¶Ç¿ùÀÉ??µLªk§ó¤F¸Ñ«e½úªº²~ÀV¦b­þ¸Ì!
«Øij¤W¶Ç§ó¶Kªñ»Ý¨Dªº½d¨Ò

Andy2483

¦^´_ 10# hcm19522


    ÁÂÁ«e½ú,¤½¦¡«ÜÃø¾Ç,ºN¯Á¤¤

¤U¸ü (212.54 KB)

2023-3-7 10:51

Andy2483

¦^´_ 18# duck_simon


    ÁÂÁ«e½ú¦^´_
«á¾ÇÄ~Äò¾Ç²ßVBA¤è®×ªº¤ß±o¦p¤U,½Ð«e½ú°Ñ¦Ò
°}¦C¤ñ¹ïA_20230308_3.zip (18.92 KB)

¤U¸ü¦¸¼Æ: 2

2023-3-8 11:36

°õ¦æµ²ªG:

¤U¸ü (104.36 KB)

2023-3-8 11:36

Option Explicit
Sub TEST_2()
Call ¶Ã¼Æ­«¸m

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) & "/") Then
            If Y("|") < 2 Then
               Y("|") = Y("|") + 1
               Else
                  B = 1: [K20] = "X": GoTo i01
            End If
      End If
   Next
   Y("|") = 0: B = 0
Next
Set Y = Nothing: Set Brr = Nothing
End Sub

Sub ¶Ã¼Æ­«¸m()
With [B4:J12]
   .Value = "=INT(MOD(RAND()*1000,49))+1"
   .Value = .Value
End With
End Sub

Andy2483

¦^´_ 20# Andy2483


    ¥H¤U¬OÂo­«½Æ«á¤ñ¹ï¶W¹L3­ÓªºVBA¤èªk,½Ð¦U¦ì«e½ú«ü¾É

Option Explicit
Sub TEST_2()
Call ¶Ã¼Æ­«¸m

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

Andy2483

¦^´_ 22# Andy2483


    ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾Ç©µ¦ù¾Ç²ß,¤£¨Ï¥Î¦r¨åÂo­«½Æªº¤è®×,½Ð¦U¦ì«e½ú«ü¾É

Option Explicit
Sub TEST_2()
Call ¶Ã¼Æ­«¸m

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

Andy2483

¦^´_ 25# duck_simon


    ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
¦A¦¸ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾Ç½Æ²ß¬Q¤Ñªº²ßÃD¤ß±oµù¸Ñ¦p¤U,½Ð°Ñ¦Ò
¸Õ«ö¤F´X¦Ê¦¸³Ì¦h4­Ó¤ñ¹ï¤W,¨S°¾°]¹B

Option Explicit
Sub TEST_2()
Call ¶Ã¼Æ­«¸m
'¡ô°õ¦æ(¶Ã¼Æ­«¸m)°Æµ{¦¡

Dim Brr, B, V, Y, xR As Range, i&, j&
'¡ô«Å§iÅܼÆ:(Brr,B,V,Y)¬O³q¥Î«¬ÅܼÆ,xR¬OÀx¦s®æÅܼÆ,(i,j)¬Oªø¾ã¼ÆÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY³o³q¥Î«¬ÅܼƬO ¦r¨å
Brr = [A1:J12]: [A1:J12].Interior.ColorIndex = xlNone: [K20] = ""
'¡ô¥OBrr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C!¥H[A1:J12]Àx¦s®æ­È­Ë¤J,
'¥O[A1:J12]Àx¦s®æ©³¦â¬O µL¦â :[K20]Àx¦s®æ­È¬OªÅ¦r¤¸
For Each xR In [B20:F20]
'¡ô³]³v¶µ°j°é!¥OxR³oÀx¦s®æÅܼƬO [B20:F20]Àx¦s®æªº¤@®æ
   Y(xR & "/") = xR.Interior.ColorIndex: V = V & "/" & xR
   '¡ô¥OxRÅܼƳs±µ "/"ªº·s¦r¦ê¬°Key,Item¬O xRÅܼƪº©³¦â ¯Ç¤JY¦r¨å,
   '¥OV³o³q¥Î«¬ÅܼƬO ¦Û¨­³s±µ "/"¦A³s±µ xRÅܼƪº·s¦r¦ê
Next
For i = 4 To UBound(Brr)
'¡ô³]¶¶°j°é!i±q4 ¨ìBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
i01:
   For j = 2 To UBound(Brr, 2)
   '¡ô³]¶¶°j°é!j±q2 ¨ìBrr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹
      If B = 1 Then
      '¡ô¦pªGB³o³q¥Î«¬ÅܼƬO 1??
         Cells(i, j).Interior.ColorIndex = Y(Cells(i, j) & "/")
         '¡ô¥Oi°j°é¦Cj°j°éÄ檺Àx¦s®æ©³¦â¬O:
         '¥Hi°j°é¦Cj°j°éÄ檺Àx¦s®æ­È³s±µ"/"ªº·s¦r¦ê¬°Key¬dY¦r¨åªº¦^¶Ç­È
         ElseIf InStr(V & "/", "/" & Brr(i, j) & "/") Then
         '¡ô§_«h¦pªGVÅܼƳs±µ "/"ªº·s¦r¦ê¸Ì¥]§t¤F,
         '¥]§t¤F(i°j°é¦Cj°j°éÄæBrr°}¦C­È¦b«e«á¦U³s±µ"/"ªº·s¦r¦ê)
            If Y("|") < 2 Then
            '¡ô¦pªG¥H "|"¬dY¦r¨å¦^¶ÇItem­È < 2 ?
               Y("|") = Y("|") + 1
               '¡ô¥OY¦r¨å¸Ì"|"¬°keyªºitem­È²Ö¥[ 1
               Else
                  B = 1: [K20] = "X": GoTo i01
                  '¡ô¥OBÅܼƬO 1:¥O[K20]Àx¦s®æ­È¬O "X",
                  '³Ì«á¸õ¨ì i01¼Ð¥Ü¦ì¸mÄ~Äò°õ¦æ
            End If
      End If
   Next
   Y("|") = 0: B = 0
   '¡ô¥OY¦r¨å¸Ì"|"¬°keyªºitem­È¬O 0:¥OBÅܼƬO 0
Next
Set Y = Nothing: Set Brr = Nothing
'¡ô¥OÄÀ©ñÅܼÆ
End Sub
========================================
Sub ¶Ã¼Æ­«¸m()
With [B4:J12]
'¡ô¥H¤U¬OÃö©ó[B4:J12]Àx¦s®æªºµ{§Ç
   .Value = "=INT(MOD(RAND()*1000,49))+1"
   '¡ô¥O®æ­È¬O¤½¦¡:
   '0¨ì1¤§¶¡ªº¶Ã¼Æ1000­¿°£¥H49ªº¾l¼Æ¥h°£¤p¼Æ«á +1
   .Value = .Value
   '¡ô¥O®æ¸Ìªº¤½¦¡Âà¤Æ¬°­È
End With
End Sub
========================================
Option Explicit
Sub TEST_2_¦r¨åÂo­«½Æ()
Call ¶Ã¼Æ­«¸m
'¡ô¥O°õ¦æ(¶Ã¼Æ­«¸m)°Æµ{¦¡

Dim Brr, B, V, Y, xR As Range, i&, j&
'¡ô«Å§iÅܼÆ:(Brr,B,V,Y)¬O³q¥Î«¬ÅܼÆ,xR¬OÀx¦s¦s®æÅܼÆ,(i,j)¬Oªø¾ã¼ÆÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY³o³q¥Î«¬ÅܼƬO ¦r¨å
Brr = [A1:J12]: [A1:J12].Interior.ColorIndex = xlNone: [K20] = ""
'¡ô¥OBrr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C!¥H[A1:J12]Àx¦s®æ­È±a¤J,
'¥O[A1:J12]Àx¦s®æ©³¦â¬OµL¦â,¥O[K20]Àx¦s®æ­È¬O ªÅ¦r¤¸
For Each xR In [B20:F20]
'¡ô¥O³]³v¶µ°j°é!¥OxR³oÀx¦s®æÅܼƬO [B20:F20]Àx¦s®æ¸Ìªº¤@®æ
   Y(xR & "/") = xR.Interior.ColorIndex: V = V & "/" & xR
   '¡ô¥OxRÅܼƳs±µ"/"ªº·s¦r¦ê·íkey,item¬OxRÅܼƪº©³¦â¯Ç¤JY¦r¨å,
   '¥OV³o³q¥Î«¬ÅܼƬO ¦Û¨­³s±µ"/"¦A³s±µxRÅܼƪº·s¦r¦ê
Next
For i = 4 To UBound(Brr)
'¡ô³]¶¶°j°é!i±q4 ¨ìBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
i01:
   For j = 2 To UBound(Brr, 2)
   '¡ô³]¶¶°j°é!j±q2 ¨ìBrr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹¼Æ
      If B = 1 Then
      '¡ô¦pªGB³o³q¥Î«¬ÅܼƬO 1?
         Cells(i, j).Interior.ColorIndex = Y(Cells(i, j) & "/")
         '¡ô¥Oi°j°é¦Cj°j°éÄ檺Àx¦s®æ©³¦â¬O:
         '¥Hi°j°é¦Cj°j°éÄ檺Àx¦s®æ­È³s±µ"/"ªº·s¦r¦ê¬°Key¬dY¦r¨åªº¦^¶Ç­È
         ElseIf InStr(V & "/", "/" & Brr(i, j) & "/") And Y(Brr(i, j) & "/" & i) = "" Then
         '¡ô§_«h¦pªGVÅܼƳs±µ "/"ªº·s¦r¦ê¸Ì¥]§t¤F,
         '¥]§t¤F(i°j°é¦Cj°j°éÄæBrr°}¦C­È¦b«e«á¦U³s±µ"/"ªº·s¦r¦ê)
         '¦Ó¥B i°j°é¦Cj°j°éÄæBrr°}¦C­È³s±µ"/"¦A³s±µiÅܼƪº·s¦r¦ê¬dY¦r¨å¦^¶Ç­È¬OªÅ¦r¤¸?
            If Y("|") < 2 Then
            '¡ô¦pªG¥H "|"¬dY¦r¨å¦^¶ÇItem­È < 2 ?
               Y("|") = Y("|") + 1
               '¡ô¥OY¦r¨å¸Ì"|"¬°keyªºitem­È²Ö¥[ 1
               Else
                  B = 1: [K20] = "X": GoTo i01
                  '¡ô¥OBÅܼƬO 1:¥O[K20]Àx¦s®æ­È¬O "X",
                  '³Ì«á¸õ¨ì i01¼Ð¥Ü¦ì¸mÄ~Äò°õ¦æ
            End If
            Y(Brr(i, j) & "/" & i) = 1
            '¡ô¥Oi°j°é¦Cj°j°éÄæBrr°}¦C­È³s±µ"/"¦A³s±µiÅܼƪº·s¦r¦ê,
            '³o·s¦r¦ê¬°Y¦r¨åkeyªºitem­È¬O 1
      End If
   Next
   Y("|") = 0: B = 0
   '¡ô¥OY¦r¨å¸Ì"|"¬°keyªºitem­È¬O 0:¥OBÅܼƬO 0
Next
Set Y = Nothing: Set Brr = Nothing
'¡ô¥OÄÀ©ñÅܼÆ
End Sub
========================================
Option Explicit
Sub TEST_2_InstrÂo­«½Æ()
Call ¶Ã¼Æ­«¸m
'¡ô¥O°õ¦æ(¶Ã¼Æ­«¸m)°Æµ{¦¡

Dim Brr, B, V, xR As Range, i&, j&, A(49)
'¡ô«Å§iÅܼÆ:(Brr,B,V,)¬O³q¥Î«¬ÅܼÆ,xR¬OÀx¦s¦s®æÅܼÆ,(i,j)¬Oªø¾ã¼ÆÅܼÆ,A¬O¤@ºû°}¦C(0~49)
Brr = [A1:J12]: [A1:J12].Interior.ColorIndex = xlNone: [K20] = ""
'¡ô¥OBrr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C!¥H[A1:J12]Àx¦s®æ­È±a¤J,
'¥O[A1:J12]Àx¦s®æ©³¦â¬OµL¦â,¥O[K20]Àx¦s®æ­È¬O ªÅ¦r¤¸
For Each xR In [B20:F20]
'¡ô¥O³]³v¶µ°j°é!¥OxR³oÀx¦s®æÅܼƬO [B20:F20]Àx¦s®æ¸Ìªº¤@®æ
   A(Val(xR)) = xR.Interior.ColorIndex: V = V & "/" & xR
   '¡ô¥OxRÅܼÆÂà¤Æ¬°¼Æ¦r¬°¯Á¤Þ¸¹ªºA°}¦C­È¬OxRÅܼƪº©³¦â¸¹
   '¥OV³o³q¥Î«¬ÅܼƬO ¦Û¨­³s±µ"/"¦A³s±µxRÅܼƪº·s¦r¦ê
Next
For i = 4 To UBound(Brr)
'¡ô³]¶¶°j°é!i±q4 ¨ìBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
i01: A(0) = "||"
   For j = 2 To UBound(Brr, 2)
   '¡ô³]¶¶°j°é!j±q2 ¨ìBrr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹¼Æ
      If B = 1 Then
      '¡ô¦pªGB³o³q¥Î«¬ÅܼƬO 1?
         Cells(i, j).Interior.ColorIndex = A(Cells(i, j))
         '¡ô¥Oi°j°é¦Cj°j°éÄ檺Àx¦s®æ©³¦â¬O:
         '¥Hi°j°é¦Cj°j°éÄ檺Àx¦s®æ­È¬°¯Á¤Þ¸¹ªº A°}¦C­È
         ElseIf InStr(V & "/", "/" & Brr(i, j) & "/") And InStr(A(0), "/" & Brr(i, j) & "/") = 0 Then
         '¡ô§_«h¦pªGVÅܼƳs±µ "/"ªº·s¦r¦ê¸Ì¥]§t¤F,
         '¥]§t¤F(i°j°é¦Cj°j°éÄæBrr°}¦C­È¦b«e«á¦U³s±µ"/"ªº·s¦r¦ê)
         '¦Ó¥B i°j°é¦Cj°j°éÄæBrr°}¦C­È«e«á¦U³s±µ"/"ªº·s¦r¦ê¦b 0¯Á¤Þ¸¹A°}¦C¸Ì¦³³Q¥]§t?
            If Val(A(0)) < 2 Then
            '¡ô¦pªG0¯Á¤Þ¸¹A°}¦C­ÈÂà¤Æ¬°¼Æ­È«á < 2?
               A(0) = Val(A(0)) + 1 & "|" & Mid(A(0), 3)
               '¡ô¥O0¯Á¤Þ¸¹A°}¦C­È¬O ¦Û¨­Âà¤Æ¬°¼Æ­È+1 ³s±µ"|" ¦A³s±µ¦Û¨­±q²Ä3¦r¶}©l¤§«á¥þ³¡¦r¦ê,
               '²Õ¦X¦¨ªº·s¦r¦ê
               Else
                  B = 1: [K20] = "X": GoTo i01
                  '¡ô¥OBÅܼƬO 1:¥O[K20]Àx¦s®æ­È¬O "X",
                  '³Ì«á¸õ¨ì i01¼Ð¥Ü¦ì¸mÄ~Äò°õ¦æ
            End If
            A(0) = A(0) & "/" & Brr(i, j) & "/"
            '¡ô¥O0¯Á¤Þ¸¹A°}¦C­È¬O ¦Û¨­³s±µ"/" ¦A³s±µi°j°é¦Cj°j°éÄæBrr°}¦C­È,
            '³Ì«á³s±µ"/"ªº·s¦r¦ê
      End If
   Next
   B = 0
   '¡ô¥O¥OBÅܼƬO 0
Next
Set Brr = Nothing: Erase A
'¡ô¥OÄÀ©ñÅܼÆ
End Sub