[µo°Ý] ¦p¦ó¦Û¦æ§PÂ_¨Ã¶ñ¤J

j88141

½Ð°Ý¦b­ì©l¸ê®Æ¤¤(ÀÉ®×1)¦³¤­­Ó¦a¦W

¤U¸ü (19.09 KB)

2014-4-22 21:14

µM«á·Q­n¥ÎVBA§PÂ_¨Ã¦Û°Ê¶ñ¤J¨ì¥t¤@­ÓexcelÀÉ®×(ÀÉ®×2)
¹³¤U¦C³o¼Ë

¤U¸ü (28.62 KB)

2014-4-22 21:12

½Ð°Ý¦³¿ìªk¶Ü
ÀÉ®×1+2.rar (16.47 KB)

¤U¸ü¦¸¼Æ: 13

2014-4-22 21:13

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

j88141

¦^´_ 2# GBKEE


¿é¤J¤§«á«ç»ò·|¥X²{½sĶ¿ù»~
Dictionary_Ex
³o¤@­Ó¨S¦³©w¸qsub©Î function

j88141

¦^´_ 3# j88141


GBKEE¦Ñ®v

§ÚÁÙ¦³¤@­Ó°ÝÃD
´N¬O¦b¸ê®Æ2ªºA1 ¤£¬O¦³¦a¦W¶Ü
¥i¬O¦n¹³­n­«·s¿é¤J ¤~·|IJµoVBA
½Ð°Ý¸Ó«ç»ò­×§ï
©Î¬O¥[¤J¤@­ÓCommandButton©O

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

j88141

¦^´_ 5# GBKEE


    GBKEE ¦Ñ®v

¦pªG §Ú·Q§â ¦a¦W §ïÅÜ  ¦p  ­ì©l¸ê®Æª÷ªù§ï¦¨¥x¥_

¦ý¦bÀɮפG ¦n¹³ ÁÙ¬O·|¦Û°Ê·j´Mª÷ªù  µM«á¶ñ¤J

§Ú³o¨â¤Ñ ¬d¤F dictionary ³oª«¥ó  
ª¾¹D ­n¥Îd.RemoveAll ¨Ó²M°£¦r¨å¤¤ªº¼Æ¾Ú
¦ý«o¤£ª¾¹D¦p¦ó¥[¤J

¶¶«K¤@°Ý  ¬Ý¤£¤ÓÀ´³o¤@¥y...
Set Rng(2) = Rng(1).CurrentRegion.Rows(Rng(1).Row & ":" & Rng(1).Row + 2)

ÁÂÁÂGBKEE ¦Ñ®v

GBKEE

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

j88141

¦^´_ 7# GBKEE
     GBKEE ¦Ñ®v   

³o¬O§Ú·Q¥X¨Óªº
¦]¬°¤@¶}©lªº ¥u¦³¤@­Ó²Å¦X¶µ¥Ø  ´N¥i¥H¶ñ¤JÀÉ®×2¤¤

¨º¦pªG»Ý­n²Å¦X ¨â­Ó¶µ¥Ø ¤~¥i¥H¶ñ¶i
¨ºµ{¦¡½X»Ý­n«ç»ò§ï¤~¦æ

¤U¸ü (41.63 KB)

2014-4-28 22:27

¤U¸ü (34.05 KB)

2014-4-28 22:27

ÀÉ®×1+2(new).rar (29.82 KB)

¤U¸ü¦¸¼Æ: 9

2014-4-28 22:29

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

j88141

¦^´_ 9# GBKEE


    ÁÂÁÂGBKEE ¦Ñ®v   
  §Ú¾Ç¨ì«Ü¦h