GBKEE

¦^´_ 1# li_hsien

§ï¥Î Collection ª«¥ó ¤£¥Î Dictionary ª«¥ó

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim d As New Collection, AR(1 To 7), i As Integer, Rng(1 To 2) As Range, E As Variant
   
4.     On Error Resume Next              'µù¸Ñ1 :Collection·s¼WªºKEY¦p³Q¨Ï¥Î©Î¦³¿ù»~
   
5.     With Worksheets("²£«~ºÞ±±²M³æ")
   
6.         For i = 2 To .Range("J1").End(xlDown).Row
   
7.             AR(1) = .Range("E" & i)             'PRODUCT ID(A)
   
8.             AR(2) = .Range("F" & i)             'CHILDPARTNUMBER(B)
   
9.             AR(3) = .Range("C" & i)             'MP date(G)
   
10.             AR(4) = .Range("A" & i)             '¶g§O(H)
    
11.             AR(5) = .Range("B" & i)             '§ó·s¶g§O(I)
    
12.             AR(6) = DateDiff("d", Date, AR(3))  '¤u§@¤é(M)
    
13.             AR(7) = .Range("J" & i)             'Product ID & PartNumber
    
14.             d.Add AR, .Range("J" & i).Value     '¬ö¿ý²£«~ªºID & PartNumber
    
15.             
    
16.             '**** ©Ò¥H¬O¥H"²£«~"¾Ö¦³ªº¬°¥D¡A¤£¹L²£¥X"ª«®Æ"¤§«e±o¥ý§R°£"²£«~"­«½Æªº³¡¤À->Rng(1)
    
17.             '**** ·í²£«~ªºID & PartNumber(F)¦³­«½Æ®É¦³->µù¸Ñ1: Err <> 0
    
18.             If Err <> 0 Then
    
19.                 Err.Clear
    
20.                 If Rng(1) Is Nothing Then       'Rng(1)->¬ö¿ý¦³­«½Æ²£«~ªºID & PartNumber
    
21.                     Set Rng(1) = .Range("J" & i)
    
22.                 Else
    
23.                     Set Rng(1) = Union(.Range("J" & i), Rng(1))
    
24.                 End If
    
25.             End If
    
26.         Next
    
27.     End With
    
28.     With Worksheets("ª«®ÆºÞ±±²M³æ")
    
29.         For Each E In .Range("F:F").SpecialCells(xlCellTypeConstants).Offset(1)
    
30.             .Range("A" & E.Row) = d(E.Value)(1)
    
31.             .Range("B" & E.Row) = d(E.Value)(2)
    
32.             .Range("G" & E.Row) = d(E.Value)(3)
    
33.             .Range("H" & E.Row) = d(E.Value)(4)
    
34.             .Range("I" & E.Row) = d(E.Value)(5)
    
35.             .Range("M" & E.Row) = d(E.Value)(6)
    
36.             .Range("F" & E.Row) = d(E.Value)(7)
    
37.             
    
38.             '**** "²£«~"¦³ "ª«®Æ"¦³  «h§â "²£«~" ªº¸ê®ÆCOPY¨ì "ª«®Æ" ­ì¥»ªº¦ì¤l¤W
    
39.             '**** ²£«~"¦³ "ª«®Æ"¦³ -> Err = 0
    
40.             If Err = 0 Then                     'ª«®ÆªºID & PartNumber,¦s¦b²£«~ªºID & PartNumber¤¤
    
41.                 d.Remove E.Value                '°£¥h:²£«~ªºID & PartNumber
    
42.             '**** ¦³²Ä¤Gµ§¤w°£¥hªº²£«~ID & PartNumber-> ¤w°£¥h(¨S¦³³oKEY­È): Err <> 0
    
43.             ElseIf Err <> 0 And E <> "" Then
    
44.             '**** "²£«~"¨S¦³ "ª«®Æ"¦³ «h§â"ª«®Æ"¾ãÄæ§R°£±¼ -> Rng(2)
    
45.                 If Rng(2) Is Nothing Then       '¨úªºÀx¦s®æªº¦ì¸m
    
46.                     Set Rng(2) = E
    
47.                 Else
    
48.                     Set Rng(2) = Union(E, Rng(2))
    
49.                 End If
    
50.             End If
    
51.             Err.Clear
    
52.         Next
    
53.         If d.Count > 0 Then
    
54.             
    
55.             'C ***²£«~"¦³ "ª«®Æ"¨S¦³ «h§â·s¼W¦h¥X¨Óªº¼W¥[¨ì "ª«®Æ" ³Ì¤U­±
    
56.             i = 0
    
57.             With .Range("A1").End(xlDown)
    
58.                 For Each E In d
    
59.                     i = i + 1
    
60.                     .Offset(i).Range("A1") = E(1)
    
61.                     .Offset(i).Range("B1") = E(2)
    
62.                     .Offset(i).Range("G1") = E(3)
    
63.                     .Offset(i).Range("H1") = E(4)
    
64.                     .Offset(i).Range("I1") = E(5)
    
65.                     .Offset(i).Range("M1") = E(6)
    
66.                     .Offset(i).Range("F1") = E(7)
    
67.                 Next
    
68.             End With
    
69.         End If
    
70.     End With
    
71.     If Not Rng(1) Is Nothing Then
    
72.     '**** §R°£"²£«~"­«½Æªº³¡¤À->Rng(1)
    
73.         If MsgBox("§R°£­«½Æªº[ID & PartNumber]", vbQuestion + vbYesNo, "²£«~ºÞ±±²M³æ") = vbYes Then
    
74.             Rng(1).EntireRow.Delete
    
75.         End If
    
76.     End If
    
77.    
    
78.     If Not Rng(2) Is Nothing Then
    
79.         '**** "²£«~"¨S¦³ "ª«®Æ"¦³ «h§â"ª«®Æ"¾ãÄæ§R°£±¼ -> Rng(2)
    
80.         If MsgBox("§R°£­«½Æªº[ID & PartNumber]", vbQuestion + vbYesNo, "ª«®ÆºÞ±±²M³æ") = vbYes Then
    
81.            Rng(2).EntireRow.Delete
    
82.         End If
    
83.     End If
    
84.     MsgBox "Ok"
    
85. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 5# li_hsien
[A,B,C,A,A,B,C,D§Ú­n¯dA,B,C,D]

1. d.Add AR, .Range("J" & i).Value
   
2.             '****** A,B,C,A,A,B,C,D§Ú­n¯dA , B, C,D.. ³o¸Ì¦b³B²z.
   
3.             If Err <> 0 Then                   '¿ù»~: ²£«~­«½Æªº[ID & PartNumber]
   
4.                 Err.Clear
   
5.                 If Rng(1) Is Nothing Then             '¬ö¿ý:²£«~­«½Æªº[ID & PartNumber]ªº¦ì¸m
   
6.                     Set Rng(1) = .Range("J" & i)
   
7.                 Else
   
8.                     Set Rng(1) = Union(.Range("J" & i), Rng(1))
   
9.                 End If
   
10.             End If

½Æ»s¥N½X

[²£«~¨S¦³ªº¡Aª«®Æ¨ºÃäÁÙ¬O¦³¥X²{]

1. '******* §Ú¦pªG¦b²£«~¨ºÃä§R±¼¤@µ§,¦bª«®Æ¨º¨Ã¨S¦³§R°£±¼??³o¸Ì¦³§@³B¸Ì
   
2.             If Err = 0 Then                     'ª«®ÆªºID & PartNumber,¦³¦s¦b²£«~ªºID & PartNumber¤¤
   
3.                 d.Remove E.Value                '°£¥h:²£«~ªºID & PartNumber
   
4.             Else  '-> Err <> 0 ¦³¿ù»~
   
5.             '¿ù»~1:¤w°£¥h²£«~ªºID & PartNumber
   
6.             '¿ù»~2:ª«®ÆªºID & PartNumber,¤£¦s¦b²£«~ªºID & PartNumber¤¤
   
7.                 If Rng(2) Is Nothing Then       '¬ö¿ýÀx¦s®æªº¦ì¸m
   
8.                     Set Rng(2) = E
   
9.                 Else
   
10.                     Set Rng(2) = Union(E, Rng(2)) '¬ö¿ýÀx¦s®æªº¦ì¸m
    
11.                 End If
    
12.             End If
    
13.             '*********************************************************
    
14.             Err.Clear

½Æ»s¥N½X

½Ð¤W¶Ç´ú¸ÕªºÀɮ׬ݬÝ

GBKEE

¦^´_ 7# li_hsien

7#ªºÀÉ®×,°õ¦æ2#ªºµ{¦¡½X

§ä¥X ª«®ÆºÞ±±²M³æ (²£«~¨S¦³©Îª«®Æ­«½Æ)ªºID

¤U¸ü (161.57 KB)

2014-1-22 11:52

1194¦P¦C¬°²£«~ºÞ±±²M³æ,ª«®ÆºÞ±±²M³æªº³Ì«á¤@µ§¸ê®Æ

¤U¸ü (126.96 KB)

2014-1-22 11:50

¤U¸ü (129.46 KB)

2014-1-22 11:54

GBKEE

¦^´_ 9# li_hsien
2#ªºµ{¦¡½Ð§A­×§ï¤@¤U¬Ý¬Ý²£«~ºÞ±±²M³æ­«½ÆªºID

1. '********* "²£«~ºÞ±±²M³æ" §R°£­«½Æªº[ID & PartNumber]*******************
   
2.     If Not Rng(1) Is Nothing Then
   
3.         If MsgBox("§R°£­«½Æªº[ID & PartNumber]", vbQuestion + vbYesNo, "²£«~ºÞ±±²M³æ") = vbYes Then           
   
4.              Worksheets("²£«~ºÞ±±²M³æ").Activate
   
5.             Stop                                            'µ{¦¡·|°±¤î «öF8¤@¨B¤@¨B°õ¦æ¤U¥h¬Ý¤u§@ªíªº±¡§Î
   
6.             Rng(1).EntireRow.Select                  '¿ï¨ú­«½ÆªºID
   
7.            MsgBox Rng(1).EntireRow.Address
   
8.             Rng(1).EntireRow.Delete   '¥ýµù¸Ñ±¼¤£§R°£
   
9.         End If
   
10.     End If

½Æ»s¥N½X

GBKEE

¦^´_ 16# li_hsien
11#»¡: ÁÙ¬OªO¤jªºµ{¦¡§â­«½Æªº¥þ§R¤F???
µ¹§AÅ祿¤@¤U

1. If Not Rng(1) Is Nothing Then
   
2.     '**** §R°£"²£«~"­«½Æªº³¡¤À->Rng(1)
   
3.         If MsgBox("§R°£­«½Æªº[ID & PartNumber]", vbQuestion + vbYesNo, "²£«~ºÞ±±²M³æ") = vbYes Then
   
4.             Rng(1).Interior.Color = vbGreen    '­«½Æªº¼Ðµù¬°ºñ¦â
   
5.             For Each E In Rng(1).Areas
   
6.                 For i = 1 To E.Cells.Count
   
7.                     Set Rng(3) = Rng(1).EntireColumn.Find(E.Cells(i), LookIn:=xlValues)
   
8.                     If Application.Intersect(Rng(1), Rng(3)) Is Nothing Then
   
9.                         Rng(3).Interior.Color = vbRed      '«O¯d²Ä¤@µ§­«½Æªº¼Ðµù¬õ¦â
   
10.                     End If
    
11.                 Next
    
12.             Next
    
13.           '  Rng(1).EntireRow.Delete  ¥ý¤£§R°£¥h¬Ý¬Ý¦³«O¯d¦b­þ¸Ì
    
14.         End If
    
15.     End If

½Æ»s¥N½X

§A»¡:¦b³Ì¤UºÝ¼W¥[¦n¹³¤~¤£·|¥X¿ù
µ{¦¡¦³µù¸Ñ [ ¸É¤W:ª«®Æ¨S¦³ªº²£«~ID & PartNumber ]   -> ´N¬O³Ì«á¸É¤Wªº
¨º§A·Q¦p¦ó¸É¤W??

GBKEE

¦^´_ 19# li_hsien

   

¥¿±`À³¸Ó³Ñ1206¶µ¦ý§R°£«á«o¥u³Ñ1194¶µ,¦n©_©Ç³á@@

CÄæ¤é´Á®æ¦¡¤£¹ï¾É­Pªº!!!

¤U¸ü (108.27 KB)

2014-1-24 08:39

GBKEE

¦^´_ 21# li_hsien
¸Õ¸Õ¬Ý
9#©Ò»¡: ³Ì«áµ²ªG¬O"²£«~"¸ò"ª«®Æ"ªº¶µ¥Ø¼Æ·|¬O¤@¼Ëªº¨S¦³¿ù

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim d As New Collection, AR(), i As Integer, Rng As Range ', e As Variant
   
4.     On Error Resume Next              'Collection·s¼WªºKEY¦p³Q¨Ï¥Î©Î¦³¿ù»~
   
5.     With Worksheets("²£«~ºÞ±±²M³æ")
   
6.         For i = 2 To .Range("J1").End(xlDown).Row
   
7.             AR = Application.Transpose(Application.Transpose(.Range("A" & i).Resize(, 10)))
   
8.             '******  ²£«~(A:J)Äæ¦ì¸ê®Æ¾É¤J°}¦C  ****
   
9.             '1:²£«~Äæ¦ì¶g§O ,2'²£«~Äæ:§ó·s¶g§O,3:MP date,4:²£«~Ãþ§O,5:PRODUCT ID,
   
10.             '6:CHILDPARTNUMBER,7:CHILD_DESCRIPTION,8:Maker,9:MAKER & CODE.10:ID & PartNumber
    
11.             d.Add AR, .Range("J" & i)     '
    
12.             '*****§ä¥X[²£«~ºÞ±±²M³æ]­«½Æªº[ID & PartNumber]  ****
    
13.             If Err <> 0 Then
    
14.                 If Rng Is Nothing Then
    
15.                     Set Rng = .Range("J" & i)
    
16.                 Else
    
17.                     Set Rng = Union(.Range("J" & i), Rng)
    
18.                 End If
    
19.             End If
    
20.             Err.Clear
    
21.             '*****************************************************
    
22.         Next
    
23.     End With
    
24.     On Error GoTo 0              '¤£¦A³B¸Ìµ{¦¡ªº¿ù»~
    
25.     If Not Rng Is Nothing Then Rng.EntireRow.Delete
    
26.     With Worksheets("ª«®ÆºÞ±±²M³æ")
    
27.         .UsedRange.Offset(1).Clear
    
28.         For i = 1 To d.Count
    
29.             With .Range("A" & i + 1)
    
30.              '²£«~Äæ¦ì
    
31.              '1:²£«~Äæ¦ì¶g§O ,2'²£«~Äæ:§ó·s¶g§O,3:MP date,4:²£«~Ãþ§O,5:PRODUCT ID,
    
32.              '6:CHILDPARTNUMBER,7:CHILD_DESCRIPTION,8:Maker,9:MAKER & CODE.10:ID & PartNumber
    
33.                 .Range("A1") = d(i)(5)   '¾É¤Jª««~Äæ¦ìA1-M1
    
34.                 .Range("B1") = d(i)(6)
    
35.                 .Range("C1") = d(i)(7)
    
36.                 .Range("D1") = d(i)(8)
    
37.                 .Range("E1") = d(i)(9)
    
38.                 .Range("F1") = d(i)(10)
    
39.                 .Range("G1") = Format(d(i)(3), "YYYY/M/D")
    
40.                 .Range("H1") = d(i)(2)
    
41.                 .Range("I1") = d(i)(1)
    
42.                 .Range("M1") = DateDiff("d", Date, .Range("G1"))  '¤u§@¤é(M)
    
43.             End With
    
44.         Next
    
45.     End With
    
46.     MsgBox d.Count & "¶µ OK"
    
47. End Sub

½Æ»s¥N½X