GBKEE

¦^´_ 1# j88141

¦Û°Ê¶ñ¤J¨ì¥t¤@­ÓexcelÀÉ®×(ÀÉ®×2)ªºThisWorkbookµ{¦¡½X

1. Option Explicit
   
2. Dim D As Object
   
3. Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   
4.     Dim Rng As Range
   
5.     Application.EnableEvents = False
   
6.     If Target.Address = "$A$1" Then
   
7.         Dictionary_Ex
   
8.         Set Rng = Sh.[A2]
   
9.         Do While Rng <> ""
   
10.             If D.exists((Rng & Target)) Then   '¦r¨åª«¥ó¤¤¦³³o key ­È
    
11.                 D(Rng & Target).Copy Rng.Offset(, 1).Resize(3)
    
12.             Else
    
13.                 Rng.Offset(, 1).Resize(3) = ""
    
14.             End If
    
15.             Set Rng = Rng.Offset(, 2)  '¦V¥ª²¾°Ê2Äæ
    
16.         Loop
    
17.     End If
    
18.     Application.EnableEvents = True
    
19. End Sub
    
20. Private Sub Dictionary_Ex()
    
21.     Dim Rng(1 To 2) As Range, i As Integer, a
    
22.     Set D = CreateObject("SCRIPTING.DICTIONARY")
    
23.     With Workbooks("Xl0000001.xls").Sheets("¤u§@ªí1")   '­ì©l¸ê®ÆÀÉ®×¥²¶·¬O¶}±Òªº
    
24.         Set Rng(1) = .[A1]                              'AÄ檺¬P´Á¬O¦X¨Ö3¦CªºÀx¦s®æ
    
25.         Do While Rng(1) <> ""
    
26.             Set Rng(2) = Rng(1).CurrentRegion.Rows(Rng(1).Row & ":" & Rng(1).Row + 2)
    
27.             'CurrentRegion ÄÝ©Ê ¶Ç¦^ Range ª«¥ó¡A¸Óª«¥ó¥Nªí¥Ø«eªº°Ï°ì¡C¥Ø«e°Ï°ì¬O«ü¥H¥ô·NªÅ¥Õ¦C¤ÎªÅ¥ÕÄ檺²Õ¦X¬°Ãä¬Éªº½d³ò¡C°ßŪ
    
28.             'Rng(1).Row + 2 : Rng(1)©Ò¦bªº¦C¸¹+ 2
    
29.             
    
30.             For i = 2 To Rng(2).Columns.Count           '¬P´ÁªºÄæ¦ì±q²Ä2Äæ¶}©l¨ì³Ì«á¤@Äæ
    
31.               Set D(Rng(1) & Rng(2).Cells(3, i)) = Rng(2).Columns(i)
    
32.               'Rng(1) :¬P´Á , Rng(2).Cells(3, i) :¦a¦W
    
33.             Next
    
34.         Set Rng(1) = Rng(1).End(xlDown) '¤U¤@­Ó¬P´Áªº¦ì¸m
    
35.         
    
36.        Loop
    
37.      End With
    
38. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 4# j88141

1. Option Explicit
   
2. Dim D As Object
   
3. Private Sub Ex()  'ExcelÀÉ®×(ÀÉ®×2),¥[¤J¤@­ÓCommandButton ªºµ{¦¡½X
   
4.     Dim SH As Worksheet, Rng As Range
   
5.     Dictionary_Ex        '°õ¦æ³o­Óµ{§Ç
   
6.     For Each SH In Sheets  'Sheets :ExcelÀÉ®×(ÀÉ®×2)¤¤ªº¤u§@ªí¶°¦X
   
7.         Set Rng = SH.[A2]
   
8.         Do While Rng <> ""
   
9.             If D.exists(Rng & SH.[A1]) Then   '¦r¨åª«¥ó¤¤¦³³o key ­È
   
10.                 D(Rng & SH.[A1]).Copy Rng.Offset(, 1).Resize(3)
    
11.             Else
    
12.                 Rng.Offset(, 1).Resize(3) = ""
    
13.             End If
    
14.             Set Rng = Rng.Offset(, 2)  '¦V¥ª²¾°Ê2Äæ
    
15.         Loop
    
16.     Next
    
17. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 6# j88141
2# ,5# ªºµ{¦¡½X³£§ó·s,¥i¦A¬Ý¤@¦¸

GBKEE

¦^´_ 8# j88141

¨âÀɮתº"¤¤¤È" ³o¦r¦ê­n¤@­P

1. Option Explicit
   
2. Dim D As Object
   
3. Private Sub Ex()  'ExcelÀÉ®×(ÀÉ®×2),¥[¤J¤@­ÓCommandButton ªºµ{¦¡½X
   
4.     Dim SH As Worksheet, Rng As Range, i As Integer
   
5.     Dictionary_Ex               '°õ¦æ³o­Óµ{§Ç
   
6.     For Each SH In Sheets       'Sheets :ExcelÀÉ®×(ÀÉ®×2)¤¤ªº¤u§@ªí¶°¦X
   
7.         Set Rng = SH.[A3]       '½s¸¹
   
8.         Do While Rng <> ""
   
9.             For i = 4 To SH.UsedRange.Columns.Count
   
10.                 If D.exists(SH.Cells(2, i) & Rng & SH.[A1]) Then '¦r¨åª«¥ó¤¤¦³³o key ­È
    
11.                     'key ­È-> ¬P´Á & ½s¸¹ & ¦a¦W
    
12.                     '¬P´Á: Sh.Cells(2,i)
    
13.                     '½s¸¹: Rng
    
14.                     '¦a¦W" SH.[A1]
    
15.                     D(SH.Cells(2, i) & Rng & SH.[A1]).Copy Rng.Cells(1, i).Resize(4)
    
16.                 Else
    
17.                     Rng.Cells(1, i).Resize(4) = ""
    
18.                 End If
    
19.             Next
    
20.             Set Rng = Rng.End(xlDown) '¤U¤@­Ó¬P´Áªº¦ì¸m
    
21.         Loop
    
22.     Next
    
23. End Sub
    
24. Private Sub Dictionary_Ex()
    
25.     Dim Rng(1 To 3) As Range, i As Integer, a
    
26.     Set D = CreateObject("SCRIPTING.DICTIONARY")
    
27.     With Workbooks("Xl0000001.xls").Sheets("¤u§@ªí1")   '­ì©l¸ê®ÆÀÉ®×¥²¶·¬O¶}±Òªº
    
28.         Set Rng(1) = .[A4]                              '¬P´Á
    
29.         Do While Rng(1) <> ""
    
30.             Set Rng(2) = Rng(1).Offset(, 1)             '½s¸¹
    
31.             Do While Not Intersect(Rng(1).MergeArea, Rng(2).Offset(, -1)) Is Nothing
    
32.                 For i = 4 To .UsedRange.Columns.Count - 1
    
33.                   If Rng(2).Cells(1, i) <> "" Then     '
    
34.                         Set D(Rng(1) & Rng(2) & Rng(2).Cells(3, i)) = Rng(2).Cells(1, i).Resize(4)
    
35.                                                         '¦a¦W: Rng(2).Cells(3, i)
    
36.                     End If
    
37.                 Next
    
38.                 Set Rng(2) = Rng(2).End(xlDown)         '¤U¤@­Ó½s¸¹ªº¦ì¸m
    
39.             Loop
    
40.             Set Rng(1) = Rng(1).End(xlDown)             '¤U¤@­Ó¬P´Áªº¦ì¸m
    
41.        Loop
    
42.      End With
    
43. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 11# j88141

1. ¦pªG§Ú·Q­n§âÀɮפGªº"¦a°Ï"  §ï¦¨¿é¤J Àɮפ@ªº "²Å¸¹"
   
2. ¤]´N¬O±qE3¶}©lºâ°_ªºA¡BB¡BCµ¥

½Æ»s¥N½X

ªþÀɤW ÀɮפGªº"²Å¸¹" ¦b­þ¸Ì§PÂ_??

GBKEE

¦^´_ 13# j88141

¦h¥[¤@¦r¨åª«¥ó

1. Dim D(1 To 2) As Object
   
2. Private Sub Ex()  'ExcelÀÉ®×(ÀÉ®×2),¥[¤J¤@­ÓCommandButton ªºµ{¦¡½X
   
3.     Dim SH As Worksheet, Rng As Range, i As Integer
   
4.     Dictionary_Ex               '°õ¦æ³o­Óµ{§Ç
   
5.     For Each SH In Sheets       'Sheets :ExcelÀÉ®×(ÀÉ®×2)¤¤ªº¤u§@ªí¶°¦X
   
6.         Set Rng = SH.[A3]       '½s¸¹
   
7.         Do While Rng <> ""
   
8.             For i = 4 To SH.UsedRange.Columns.Count
   
9.                 If D(1).exists(SH.Cells(2, i) & Rng & SH.[A1]) Then '¦r¨åª«¥ó¤¤¦³³o key ­È
   
10.                     'key ­È-> ¬P´Á & ½s¸¹ & ¦a¦W
    
11.                     '¬P´Á: Sh.Cells(2,i)
    
12.                     '½s¸¹: Rng
    
13.                     '¦a¦W" SH.[A1]
    
14.                     D(1)(SH.Cells(2, i) & Rng & SH.[A1]).Copy Rng.Cells(1, i).Resize(4)
    
15.                     Rng.Cells(1, i).Range("a3") = D(2)(SH.Cells(2, i) & Rng & SH.[A1])
    
16.                 Else
    
17.                     Rng.Cells(1, i).Resize(4) = ""
    
18.                 End If
    
19.             Next
    
20.             Set Rng = Rng.End(xlDown) '¤U¤@­Ó¬P´Áªº¦ì¸m
    
21.         Loop
    
22.     Next
    
23. End Sub
    
24. Private Sub Dictionary_Ex()
    
25.     Dim Rng(1 To 3) As Range, i As Integer, a
    
26.     Set D(1) = CreateObject("SCRIPTING.DICTIONARY")
    
27.     Set D(2) = CreateObject("SCRIPTING.DICTIONARY")
    
28.     With Workbooks("ÀÉ®×1.xlsx").Sheets("¤u§@ªí1")   '­ì©l¸ê®ÆÀÉ®×¥²¶·¬O¶}±Òªº
    
29.         Set Rng(1) = .[A4]                          '¬P´Á
    
30.         Do While Rng(1) <> ""
    
31.             Set Rng(2) = Rng(1).Offset(, 1)             '½s¸¹
    
32.             Do While Not Intersect(Rng(1).MergeArea, Rng(2).Offset(, -1)) Is Nothing
    
33.             
    
34.                 For i = 4 To .UsedRange.Columns.Count
    
35.                   If Rng(2).Cells(1, i) <> "" Then     '
    
36.                         Set D(1)(Rng(1) & Rng(2) & Rng(2).Cells(3, i)) = Rng(2).Cells(1, i).Resize(4)
    
37.                         D(2)(Rng(1) & Rng(2) & Rng(2).Cells(3, i)) = .Cells(3, Rng(2).Cells(1, i).Column)
    
38.                     End If
    
39.                 Next
    
40.                 Set Rng(2) = Rng(2).End(xlDown)         '¤U¤@­Ó½s¸¹ªº¦ì¸m
    
41.             Loop
    
42.             Set Rng(1) = Rng(1).End(xlDown)             '¤U¤@­Ó¬P´Áªº¦ì¸m
    
43.        Loop
    
44.      End With
    
45. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 16# j88141

½Ð°Ý¦³¨S¦³¿ìªk ·íÀɮפ@¦P±Æ¸ê®Æ¦hªº®É­Ô¡A  ÀɮפG¥i¥H¥þ³¡½Æ»s¨ì¦P¤@Àx¦s®æ
¨º­n¬Ý§AÀɮפGªº¤u§@­¶Àx¦s®æªº½s±Æ!!!