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

½Ð°Ý¦p¦ó±N"ªÑ²¼¥æ©ö©ú²Ó"·J¾ã¶K¤J"³¡¦ìªí"

½Ð°Ý¦p¦ó±N"ªÑ²¼¥æ©ö©ú²Ó"·J¾ã¶K¤J"³¡¦ìªí"

½Ð°Ý¦p¦ó±N
¡¨¥æ©ö©ú²Ó¡¨ªí¤¤ªº©ú²Ó
¨Ì¦UªÑ¥[Á`¡¨¼Æ¶q¡¨¤ÎÁ`¡¨ª÷ÃB¡¨
¦A¨Ì­ÓªÑ¶R/½æ
¶K¤J¡§¡¨³¡¦ìªí¡¨¡¨¤¤ªº¶R¤J/½æ¥XªÑ¼Æ,ª÷ÃB
¦pµL®w¦s«h¨Ì¥N½X¶¶§Ç·s´¡¤J¤@¦C
¶K¤J¥N¸¹,¦WºÙ,¶R¤J/½æ¥XªÑ¼Æ,ª÷ÃB

¥d¦í¦n´X¤Ñ¤F
ÁÂÁÂÀ°¦£

ªÑ²¼³¡¦ì.rar (21.55 KB)

¤p¤Hª«

¦^´_ 1# jasonwu0114


   ¦³°ª¤â¥i¥H«ü¾É¤@¤U¶Ü
ÁÂÁÂ
¤p¤Hª«

TOP

¦^´_ 2# jasonwu0114
¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Sub Ex()
  3.     Dim D(1 To 2) As Object, X As Integer, Rng As Range, Ar As Variant, S As String
  4.     Set D(1) = CreateObject("SCRIPTING.DICTIONARY")                '¦r¨åª«¥ó1
  5.     Set D(2) = CreateObject("SCRIPTING.DICTIONARY")                '¦r¨åª«¥ó2
  6.     Set Rng = Sheets("¥æ©ö©ú²Ó").Range("B4")
  7.     Do While Rng <> ""                                             '°j°é: Ū¨ú (¶R,½æ) ¸ê®Æ
  8.         With Rng
  9.             If Rng = "¶R" Then X = 1 Else X = 2                    '¦r¨åª«¥ó ¶R(1),½æ (2)
  10.             If Not D(X).Exists(.Offset(, 1).Value) Then            'Exists ¦r¨åª«¥ó(KEY)¬O§_¦s¦b : ¤£¦s¦b
  11.                 D(X)(.Offset(, 1).Value) = Array(Val(.Offset(, 2)), Val(.Offset(, 2)) * .Offset(, 3).Value) '¦r¨åª«¥ó(KEY)=°}¦C
  12.             Else                                                    '¦r¨åª«¥ó: ¦s¦b
  13.                 Ar = D(X)(.Offset(, 1).Value)                       '°}¦C=¦r¨åª«¥ó(KEY)
  14.                 Ar(0) = Ar(0) + Val(.Offset(, 2))                   '°}¦C(0)=Ar(0)+¼Æ¦r
  15.                 Ar(1) = Ar(1) + Val(.Offset(, 2)) * .Offset(, 3)    '°}¦C(1)=Ar(1)+¼Æ¦r
  16.                 D(X)(.Offset(, 1).Value) = Ar                       '¦r¨åª«¥ó(KEY)=°}¦C
  17.             End If
  18.         End With
  19.         Set Rng = Rng.Offset(1)                                     '¤U¤@­Ó¶R,½æ¸ê®Æ
  20.     Loop
  21.     Set Rng = Sheets("³¡¦ìªí").Range("A5")
  22.     Do While Rng <> ""                                               '°j°é: Ū¨ú®w¦s(ªÑ²¼¥N¸¹)
  23.         With Rng
  24.             S = .Offset(, 1) & " " & Rng                             'S : ¦r¨åª«¥óªº(KEY)
  25.             If D(1).Exists(S) Then                                   'Exists= True: ¦r¨åª«¥ó(S)->¦s¦b
  26.                 .Range("E1") = D(1)(S)(0)                            'D(1)(S)(0):  ¦r¨åª«¥ó(S)¤º®e¬°°}¦C->²Ä(0)¤¸¯À­È
  27.                 .Range("F1") = D(1)(S)(1)
  28.                 D(1).Remove (S)                                      'Remove: §â¦¨­û,±q¦r¨åª«¥ó(1)²¾°£
  29.             End If
  30.             If D(2).Exists(S) Then
  31.                 .Range("G1") = D(2)(S)(0)
  32.                 .Range("I1") = D(2)(S)(1)
  33.                 D(2).Remove (S)
  34.             End If
  35.         End With
  36.         Set Rng = Rng.Offset(1)
  37.     Loop
  38.     '*** µL®w¦s«h¨Ì¥N½X¶¶§Ç·s´¡¤J¤@¦C        *********
  39.     For Each Ar In D(1).KEYS                                         'Remove«á³Ñ¾lªº¦r¨åª«¥ó
  40.         Rng.Resize(, 12).Insert
  41.         'Rng.Insert ´¡¤J«á,Rng·|¤U²¾¦b´¡¤JªºÀx¦s®æ¤U¤è,Ä~Äò´¡¤J,Rng·|¤U²¾¦b´¡¤JªºÀx¦s®æ¤U¤è
  42.         With Rng.Offset(-1)
  43.             .Range("A1") = Split(Ar, " ")(1)
  44.             .Range("B1") = Split(Ar, " ")(0)
  45.             .Range("E1") = D(1)(Ar)(0)
  46.             .Range("F1") = D(1)(Ar)(1)
  47.             If D(2).Exists(Ar) Then
  48.                 .Range("G1") = D(2)(Ar)(0)
  49.                 .Range("I1") = D(2)(Ar)(1)
  50.                 D(2).Remove (Ar)
  51.             End If
  52.         End With
  53.     Next
  54.     For Each Ar In D(2).KEYS
  55.         Rng.Resize(, 12).Insert
  56.         With Rng.Offset(-1)
  57.             .Range("A1") = Split(Ar, " ")(1)
  58.             .Range("B1") = Split(Ar, " ")(0)
  59.             .Range("G1") = D(2)(Ar)(0)
  60.             .Range("I1") = D(2)(Ar)(1)
  61.         End With
  62.     Next
  63. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 3# GBKEE


    ·P®¦!!!!¯u¬O¨ü¯q¨}¦h!!!§Ú·Q§Ú§â®Ñ½Äê¤F¤]¼g¤£¥X¨Ó
¥t¥~¦A½Ð°Ý
µ{¦¡¤¤¡§¡¨¡¨µL®w¦s«h¨Ì¥N½X¶¶§Ç·s´¡¤J¤@¦C¡¨¡¨
°õ¦æ«á¦n¹³¥u·|¦b³Ì«á©¹¤U·s¼W¤@¦C
1.¬O§_¥i·Ó©Ò¦³®w¦sªºªÑ²¼¥N¸¹¶¶§Ç´¡¤J¤@¦C©ÎªÌ³Ì«á¦A¥þ³¡°µ±Æ§Ç
2.¦]¬°Àx¦s®æ¤º¦³­pºâ¤½¦¡¬O§_¥i½Æ»s¾ã¦C¦A·s´¡¤J
ÁÂÁÂ
¤p¤Hª«

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2013-11-27 17:45 ½s¿è

¦^´_ 4# jasonwu0114
  1. Option Explicit
  2. Sub Ex()
  3.     Dim D(1 To 2) As Object, X As Integer, Rng As Range, Ar As Variant, S As String
  4.     Set D(1) = CreateObject("SCRIPTING.DICTIONARY")                '¦r¨åª«¥ó1
  5.     Set D(2) = CreateObject("SCRIPTING.DICTIONARY")                '¦r¨åª«¥ó2
  6.     Set Rng = Sheets("¥æ©ö©ú²Ó").Range("B4")
  7.     Do While Rng <> ""                                             '°j°é: Ū¨ú (¶R,½æ) ¸ê®Æ
  8.         With Rng
  9.             If Rng = "¶R" Then X = 1 Else X = 2                    '¦r¨åª«¥ó ¶R(1),½æ (2)
  10.             If Not D(X).Exists(.Offset(, 1).Value) Then            'Exists ¦r¨åª«¥ó(KEY)¬O§_¦s¦b : ¤£¦s¦b
  11.                 D(X)(.Offset(, 1).Value) = Array(Val(.Offset(, 2)), Val(.Offset(, 2)) * .Offset(, 3).Value) '¦r¨åª«¥ó(KEY)=°}¦C
  12.             Else                                                    '¦r¨åª«¥ó: ¦s¦b
  13.                 Ar = D(X)(.Offset(, 1).Value)                       '°}¦C=¦r¨åª«¥ó(KEY)
  14.                 Ar(0) = Ar(0) + Val(.Offset(, 2))                   '°}¦C(0)=Ar(0)+¼Æ¦r
  15.                 Ar(1) = Ar(1) + Val(.Offset(, 2)) * .Offset(, 3)    '°}¦C(1)=Ar(1)+¼Æ¦r
  16.                 D(X)(.Offset(, 1).Value) = Ar                       '¦r¨åª«¥ó(KEY)=°}¦C
  17.             End If
  18.         End With
  19.         Set Rng = Rng.Offset(1)                                     '¤U¤@­Ó¶R,½æ¸ê®Æ
  20.     Loop
  21.     Set Rng = Sheets("³¡¦ìªí").Range("A5")
  22.     Do While Rng <> ""                                               '°j°é: Ū¨ú®w¦s(ªÑ²¼¥N¸¹)
  23.         With Rng
  24.             S = .Offset(, 1) & " " & Rng                             'S : ¦r¨åª«¥óªº(KEY)
  25.             If D(1).Exists(S) Then                                   'Exists= True: ¦r¨åª«¥ó(S)->¦s¦b
  26.                 .Range("E1") = D(1)(S)(0)                            'D(1)(S)(0):  ¦r¨åª«¥ó(S)¤º®e¬°°}¦C->²Ä(0)¤¸¯À­È
  27.                 .Range("F1") = D(1)(S)(1)
  28.                 D(1).Remove (S)                                      'Remove: §â¦¨­û,±q¦r¨åª«¥ó(1)²¾°£
  29.             End If
  30.             If D(2).Exists(S) Then
  31.                 .Range("G1") = D(2)(S)(0)
  32.                 .Range("I1") = D(2)(S)(1)
  33.                 D(2).Remove (S)
  34.             End If
  35.         End With
  36.         Set Rng = Rng.Offset(1)
  37.     Loop
  38.     Set Rng = Rng.Offset(-1).Resize(, 12)
  39.     '*** µL®w¦s«h¨Ì¥N½X¶¶§Ç·s´¡¤J¤@¦C        *********
  40.     For Each Ar In D(1).KEYS                                       'Remove«á³Ñ¾lªº¦r¨åª«¥ó
  41.         Rng.Copy                                                   '½Æ»s
  42.         Rng.Offset(1).Insert Shift:=xlDown                         '¤U¤@¦C´¡¤W½Æ»sªºÀx¦s®æ
  43.         
  44.         With Rng.Offset(1)
  45.             .SpecialCells(xlCellTypeConstants, 3) = ""       '²M°£ ¤U¤@¦C´¡¤W½Æ»sªºÀx¦s®æªº[¤å¦r,¼Æ¦r]
  46.             .Range("A1") = Split(Ar, " ")(1)
  47.             .Range("B1") = Split(Ar, " ")(0)
  48.             .Range("E1") = D(1)(Ar)(0)
  49.             .Range("F1") = D(1)(Ar)(1)
  50.             If D(2).Exists(Ar) Then
  51.                 .Range("G1") = D(2)(Ar)(0)
  52.                 .Range("I1") = D(2)(Ar)(1)
  53.                 D(2).Remove (Ar)
  54.             End If
  55.         End With
  56.         Set Rng = Rng.Offset(1)
  57.     Next
  58.     For Each Ar In D(2).KEYS
  59.         Rng.Copy
  60.         Rng.Offset(1).Insert Shift:=xlDown
  61.         With Rng.Offset(1)
  62.             .SpecialCells(xlCellTypeConstants, 3) = ""
  63.             .Range("A1") = Split(Ar, " ")(1)
  64.             .Range("B1") = Split(Ar, " ")(0)
  65.             .Range("G1") = D(2)(Ar)(0)
  66.             .Range("I1") = D(2)(Ar)(1)
  67.         End With
  68.         Set Rng = Rng.Offset(1)
  69.     Next
  70.     Set Rng = Rng.Offset(-1).CurrentRegion  'CurrentRegion:©µ¦ùªº½d³ò
  71.     '********* ±Æ§Ç :¥DÁäªÑ²¼¥N¸¹
  72.     Rng.Sort Key1:=Rng.Cells(1), Order1:=xlAscending, Header:=xlGuess, _
  73.         OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
  74.         :=xlStroke, DataOption1:=xlSortNormal
  75. End Sub
  76. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : ¯àµ½¥Î®É¶¡ªº¤H¡A¥²¯à´x´¤¦Û¤v§V¤Oªº¤è¦V¡C
ªð¦^¦Cªí ¤W¤@¥DÃD