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

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

¥»©«³Ì«á¥Ñ 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

¥»©«³Ì«á¥Ñ 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

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

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

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

TOP

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

TOP

¦^´_ 16# j88141

½Ð°Ý¦³¨S¦³¿ìªk ·íÀɮפ@¦P±Æ¸ê®Æ¦hªº®É­Ô¡A  ÀɮפG¥i¥H¥þ³¡½Æ»s¨ì¦P¤@Àx¦s®æ
¨º­n¬Ý§AÀɮפGªº¤u§@­¶Àx¦s®æªº½s±Æ!!!
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : §ïÅܦۤv¬O¦Û±Ï¡A¼vÅT§O¤H¬O±Ï¤H¡C
ªð¦^¦Cªí ¤W¤@¥DÃD