ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

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

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

¥»©«³Ì«á¥Ñ j88141 ©ó 2014-4-22 21:15 ½s¿è

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

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


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

ÀÉ®×1©M2.rar (16.47 KB)

¥»©«³Ì«á¥Ñ GBKEE ©ó 2014-4-27 05:56 ½s¿è

¦^´_ 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
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 2# GBKEE


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

TOP

¦^´_ 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

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2014-4-27 06:04 ½s¿è

¦^´_ 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
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 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

TOP

¦^´_ 6# j88141
2# ,5# ªºµ{¦¡½X³£§ó·s,¥i¦A¬Ý¤@¦¸
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 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«ç»ò§ï¤~¦æ



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

TOP

¦^´_ 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
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 9# GBKEE


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

TOP

        ÀR«ä¦Û¦b : ­n¥Î¤ß¡A¤£­n¾Þ¤ß¡B·Ð¤ß¡C
ªð¦^¦Cªí ¤W¤@¥DÃD