register313

¦^´_ 15# donod

1. Option Explicit
   
2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
3. Dim xX As Integer, Ar(), A As Range, B As Range, i As Integer, x As Variant
   
4. If Target.Address(0, 0) = "Q8" Then       '¿ï¾Ü¤F Q8
   
5.     Set B = Range("V9:AJ20")              '¨î­q B ²Õ(¤À¼Æ- PT8) ½d³ò
   
6.     xX = 0                                ' QÄæ
   
7. ElseIf Target.Address(0, 0) = "R8" Then   '¿ï¾Ü¤F R8
   
8.     Set B = Range("AM9:BA20")             '¨î­q C²Õ(¤À¼Æ-PT8) ½d³ò
   
9.     xX = 1                                ' PÄæ ¥k²¾¤@Äæ :RÄæ
   
10. ElseIf Target.Address(0, 0) = "S8" Then   '¿ï¾Ü¤F S8
    
11.     Set B = Range("BD9:BR20")             '¨î­q D²Õ(¤À¼Æ-PT8) ½d³ò
    
12.     xX = 2                                ' PÄæ ¥k²¾¤GÄæ :SÄæ
    
13. ElseIf Target.Address(0, 0) = "T8" Then   '¿ï¾Ü¤F T8
    
14.     Set B = Range("BU9:CI20")             '¨î­q E²Õ(¤À¼Æ-PT8) ½d³ò
    
15.     xX = 3                                ' PÄæ ¥k²¾¤TÄæ :TÄæ
    
16. Else
    
17.     Exit Sub                              'Â÷¶}µ{§Ç
    
18. End If
    
19. Set A = Range("G9:P20")                   '¨î­q A ²Õ(PT1-PT8) ½d³ò
    
20. A.Interior.ColorIndex = xlNone            '²M°£A ²Õ(PT1-PT8) ½d³ò¹Ï¼Ë
    
21. B.Interior.ColorIndex = xlNone            '²M°£B ,C , D. ²Õ ½d³ò¹Ï¼Ë
    
22. ReDim Ar(1 To A.Rows.Count)               '­«·s«Å§i °}¦Cªººû¼Æ
    
23. For i = 1 To B.Rows.Count                 '¨ú±oB,C,D,²Õªº (PT1-PT8) ªº¤º®e  ¸m¤J°}¦C Ar
    
24.     Ar(i) = Join(Application.Transpose(Application.Transpose(B(i, 6).Resize(, 10))), ",")
    
25. Next
    
26. For i = 1 To A.Rows.Count
    
27.     x = Join(Application.Transpose(Application.Transpose(A(i, 1).Resize(, 10))), ",")
    
28.     x = Application.Match(x, Ar, 0)       '¤u§@ªí¨ç¼ÆMatch ¦bAr´M§ä ¬Û¦P¦r¦ê
    
29.     A(i, 11 + xX) = ""                    '²M°£
    
30.     If Not IsError(x) Then                '§ä¨ì¶Ç¦^¼Æ¦r
    
31.         B(x, 6).Resize(, 10).Interior.ColorIndex = 6
    
32.         A(i, 1).Resize(, 10).Interior.ColorIndex = 6
    
33.         A(i, 11 + xX) = B(x, 1)           'B,C,D,E²Õªº¤À¼Æ
    
34.     End If
    
35. Next
    
36. End Sub

½Æ»s¥N½X

¥t¥~«Øij¨C±i¤u§@ªíÀ³¦³¬Û¦P¤§®æ¦¡(¥i¥H§@¨ìªº),³o¼Ë´N¥i¥H¥u¥Î¤@­Ó¬¡­¶Ã¯¼Ò²Õ
¦p¨C±i¤u§@ªí¤§®æ¦¡¤£¦P,¨º´N­n¨C±i¤u§@ªí¤À§O©ñ¤u§@ªí¼Ò²Õ

register313

¦^´_ 22# donod

1. Option Explicit
   
2. 'ThisWorkbook ªº¹w³]¨Æ¥ó
   
3. Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
   
4. Dim xX As Integer, Ar(), A As Range, B As Range, i As Integer, x As Variant
   
5. With Sh
   
6.     If Target.Address(0, 0) = "R8" Then         '¿ï¾Ü¤F P7
   
7.         Set B = Range("Z9:AO1500")              '¨î­q B ²Õ(³Ì³»1­Ó§Q¼í- ³Ì«á³Ì©³1­ÓOPT) ½d³ò
   
8.         '¦ÓSet B = .Range("V9:AJ20"), Range¤§«e ¦³ ¤@ÂI ¥Nªí¬O ¥H With Target ¬°°òÂI ©ÒÂX®iªº½d³ò
   
9.         '  B.Select                             ' ¥[¤W³o¦æ ¥iÅã¥Ü Bªº½d³ò¦b­þ¸Ì
   
10.         xX = 0                                  ' PÄæ
    
11.     ElseIf Target.Address(0, 0) = "S8" Then     '¿ï¾Ü¤F Q7
    
12.         Set B = Range("AR9:BG1500")             '¨î­q C²Õ(³Ì³»1­Ó§Q¼í- ³Ì«á³Ì©³1­ÓOPT) ½d³ò
    
13.         'B.Select
    
14.         xX = 1                                  ' PÄæ ¥k²¾¤@Äæ :QÄæ
    
15.     ElseIf Target.Address(0, 0) = "T8" Then     '¿ï¾Ü¤F R7
    
16.         Set B = Range("BJ9:BY1500")             '¨î­q D²Õ(³Ì³»1­Ó§Q¼í- ³Ì«á³Ì©³1­ÓOPT) ½d³ò
    
17.         xX = 2                                  ' PÄæ ¥k²¾¤GÄæ :RÄæ
    
18.     ElseIf Target.Address(0, 0) = "U8" Then     '¿ï¾Ü¤F Q7
    
19.         Set B = Range("CB9:CQ1500")             '¨î­q C²Õ(³Ì³»1­Ó§Q¼í- ³Ì«á³Ì©³1­ÓOPT) ½d³ò
    
20.         xX = 3                                  ' PÄæ ¥k²¾3Äæ :QÄæ
    
21.     ElseIf Target.Address(0, 0) = "V8" Then     '¿ï¾Ü¤F R7
    
22.         Set B = Range("CT9:DI1500")             '¨î­q D²Õ(³Ì³»1­Ó§Q¼í- ³Ì«á³Ì©³1­ÓOPT) ½d³ò
    
23.         xX = 4                                  ' PÄæ ¥k²¾4Äæ :RÄæ
    
24.     ElseIf Target.Address(0, 0) = "W8" Then     '¿ï¾Ü¤F R7
    
25.         Set B = Range("DL9:EA1500")             '¨î­q D²Õ(³Ì³»1­Ó§Q¼í- ³Ì«á³Ì©³1­ÓOPT) ½d³ò
    
26.         xX = 5                                  ' PÄæ ¥k²¾5Äæ :RÄæ
    
27.     Else
    
28.         Exit Sub                                'Â÷¶}µ{§Ç
    
29.     End If
    
30.     Set A = Range("H9:Q1500")                   '¨î­q A ²Õ(¥þ³¡OPT) ½d³ò
    
31.     A.Interior.ColorIndex = xlNone              '²M°£A ²Õ(OPT1-OPT10) ½d³ò¹Ï¼Ë
    
32.     B.Interior.ColorIndex = xlNone              '²M°£B ,C , D. ²Õ ½d³ò¹Ï¼Ë
    
33.     ReDim Ar(1 To A.Rows.Count)                 '­«·s«Å§i °}¦Cªººû¼Æ
    
34.     For i = 1 To B.Rows.Count                   '¨ú±oB,C,D,²Õªº (OPT1-OPT10) ªº¤º®e  ¸m¤J°}¦C Ar
    
35.         Ar(i) = Join(Application.Transpose(Application.Transpose(B(i, 7).Resize(, 10))), ",")
    
36.     Next
    
37.     For i = 1 To A.Rows.Count
    
38.         x = Join(Application.Transpose(Application.Transpose(A(i, 1).Resize(, 10))), ",")
    
39.         x = Application.Match(x, Ar, 0)         '¤u§@ªí¨ç¼ÆMatch ¦bAr´M§ä ¬Û¦P¦r¦ê
    
40.         A(i, 11 + xX) = ""                      '²M°£
    
41.         If Not IsError(x) Then                  '§ä¨ì¶Ç¦^¼Æ¦r
    
42.             B(x, 7).Resize(, 10).Interior.ColorIndex = 6
    
43.             A(i, 1).Resize(, 10).Interior.ColorIndex = 6
    
44.             A(i, 11 + xX) = B(x, 1)             'B,C,D,²Õªº¤À¼Æ
    
45.         End If
    
46.     Next
    
47. End With
    
48. End Sub

½Æ»s¥N½X

register313

¦^´_ 24# donod

Set B = Range("Z9:AO1500")
«hB(1,1)= Range("Z9")   B(1,2)= Range("AA9")   B(1,3)= Range("AB9")  ¡K
  B(2,1)= Range("Z10")   B(2,2)= Range("AA10")   B(2,3)= Range("AB10")  ¡K
­Yi=1,«hB(i, 7).Resize(, 10)= B(1, 7).Resize(, 10)= Range("AF9").Resize(, 10) = Range("AF9:AO9")
­Yi=2,«hB(i, 7).Resize(, 10)= B(2, 7).Resize(, 10)= Range("AF10").Resize(, 10) = Range("AF10:AO10")

Set A = Range("H9:Q1500")
­YxX=0,i=1,«hA(i, 11 + xX)= A(1, 11)= Range("R9")
­YxX=0,i=2,«hA(i, 11 + xX)= A(2, 11)= Range("R10")

register313

¦^´_ 26# donod

¬Ý¬Ý¹ï¤£¹ï

1. Option Explicit
   
2. 'ThisWorkbook ªº¹w³]¨Æ¥ó
   
3. Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
   
4. Dim xX As Integer, Ar(), Br(), A As Range, B As Range, i As Integer, x As Variant
   
5. With Sh
   
6.     If Target.Address(0, 0) = "R8" Then         '¿ï¾Ü¤F P7
   
7.         Set B = Range("Z9:AO9").Resize(300)     '¨î­q B ²Õ(³Ì³»1­Ó§Q¼í- ³Ì«á³Ì©³1­ÓOPT) ½d³ò
   
8.         '¦ÓSet B = .Range("V9:AJ20"), Range¤§«e ¦³ ¤@ÂI ¥Nªí¬O ¥H With Target ¬°°òÂI ©ÒÂX®iªº½d³ò
   
9.         '  B.Select                             ' ¥[¤W³o¦æ ¥iÅã¥Ü Bªº½d³ò¦b­þ¸Ì
   
10.         xX = 0                                  ' PÄæ
    
11.     ElseIf Target.Address(0, 0) = "S8" Then     '¿ï¾Ü¤F Q7
    
12.         Set B = Range("AR9:BG9").Resize(300)    '¨î­q C²Õ(³Ì³»1­Ó§Q¼í- ³Ì«á³Ì©³1­ÓOPT) ½d³ò
    
13.         'B.Select
    
14.         xX = 1                                  ' PÄæ ¥k²¾¤@Äæ :QÄæ
    
15.     ElseIf Target.Address(0, 0) = "T8" Then     '¿ï¾Ü¤F R7
    
16.         Set B = Range("BJ9:BY9").Resize(300)    '¨î­q D²Õ(³Ì³»1­Ó§Q¼í- ³Ì«á³Ì©³1­ÓOPT) ½d³ò
    
17.         xX = 2                                  ' PÄæ ¥k²¾¤GÄæ :RÄæ
    
18.     ElseIf Target.Address(0, 0) = "U8" Then     '¿ï¾Ü¤F Q7
    
19.         Set B = Range("CB9:CQ9").Resize(300)    '¨î­q C²Õ(³Ì³»1­Ó§Q¼í- ³Ì«á³Ì©³1­ÓOPT) ½d³ò
    
20.         xX = 3                                  ' PÄæ ¥k²¾3Äæ :QÄæ
    
21.     ElseIf Target.Address(0, 0) = "V8" Then     '¿ï¾Ü¤F R7
    
22.         Set B = Range("CT9:DI9").Resize(300)    '¨î­q D²Õ(³Ì³»1­Ó§Q¼í- ³Ì«á³Ì©³1­ÓOPT) ½d³ò
    
23.         xX = 4                                  ' PÄæ ¥k²¾4Äæ :RÄæ
    
24.     ElseIf Target.Address(0, 0) = "W8" Then     '¿ï¾Ü¤F R7
    
25.         Set B = Range("DL9:EA9").Resize(300)    '¨î­q D²Õ(³Ì³»1­Ó§Q¼í- ³Ì«á³Ì©³1­ÓOPT) ½d³ò
    
26.         xX = 5                                  ' PÄæ ¥k²¾5Äæ :RÄæ
    
27.     Else
    
28.         Exit Sub                                'Â÷¶}µ{§Ç
    
29.     End If
    
30.     Set A = Range("H9:Q9").Resize(50)                   '¨î­q A ²Õ(¥þ³¡OPT) ½d³ò
    
31.     A.Interior.ColorIndex = xlNone              '²M°£A ²Õ(OPT1-OPT10) ½d³ò¹Ï¼Ë
    
32.     B.Interior.ColorIndex = xlNone              '²M°£B ,C , D. ²Õ ½d³ò¹Ï¼Ë
    
33.   ' ReDim Ar(1 To A.Rows.Count)                 '­«·s«Å§i °}¦Cªººû¼Æ
    
34.     ReDim Br(1 To B.Rows.Count)
    
35.     For i = 1 To B.Rows.Count                   '¨ú±oB,C,D,²Õªº (OPT1-OPT10) ªº¤º®e  ¸m¤J°}¦C Ar
    
36.         Br(i) = Join(Application.Transpose(Application.Transpose(B(i, 7).Resize(, 10))), ",")
    
37.     Next
    
38.     For i = 1 To A.Rows.Count
    
39.         x = Join(Application.Transpose(Application.Transpose(A(i, 1).Resize(, 10))), ",")
    
40.         x = Application.Match(x, Br, 0)         '¤u§@ªí¨ç¼ÆMatch ¦bAr´M§ä ¬Û¦P¦r¦ê
    
41.         A(i, 11 + xX) = ""                      '²M°£
    
42.         If Not IsError(x) Then                  '§ä¨ì¶Ç¦^¼Æ¦r
    
43.             B(x, 7).Resize(, 10).Interior.ColorIndex = 6
    
44.             A(i, 1).Resize(, 10).Interior.ColorIndex = 6
    
45.             A(i, 11 + xX) = B(x, 1)             'B,C,D,²Õªº¤À¼Æ
    
46.         End If
    
47.     Next
    
48. End With
    
49. End Sub

½Æ»s¥N½X