- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
¦^´_ 5# duck_simon
¤µ¤Ñקï½Æ²ß¤F¤@¤U,½Ð«e½ú°Ñ¦Ò
°õ¦æ«e:
°õ¦æµ²ªG:
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 |
|