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

jasonwu0114

½Ð°Ý¦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
ÁÂÁÂÀ°¦£

GBKEE

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

jasonwu0114

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

GBKEE

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

jasonwu0114

¦^´_ 1# jasonwu0114


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