li_hsien

¦^´_ 10# GBKEE


³o¨Ç¬O§Ú­«½Æªº
$1806:$1810,$1800:$1802,$1798:$1798,$1794:$1795,$1791:$1792,$1788:$1789,$1785:$1785,$1772:$1772,$1764:$1764,$1754:$1758,$1748:$1750,$1743:$1743,$1739:$1740,$1736:$1737,$1733:$1734,$1730:$1730,$1718:$1718,$1710:$1710,$1698:$1701,$1691:$1691,$1688:$1689


¦p¦³­«½Æ§Ú¥u­n§R°£­«½Æªº³¡¤À
¯d°ß¤@

ÁÙ¬OªO¤jªºµ{¦¡§â­«½Æªº¥þ§R¤F???

§Ú¤]¤£½T©w¬O¤£¬O

³Â·Ð¤j¤jÀ°§Ú¬Ý¬Ý

ÁÂÁ§A

Hsieh

¦^´_ 1# li_hsien

1. Sub ex()
   
2. Dim Ar
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. With Sheets("²£«~ºÞ±±²M³æ")
   
5. Ar = .UsedRange.Value
   
6. For i = 2 To UBound(Ar, 1) '°O¿ý²£«~¤£­«ÂаO¿ý
   
7.    d(Ar(i, 10)) = Array(Ar(i, 5), Ar(i, 6), Ar(i, 7), Ar(i, 8), Ar(i, 9), Ar(i, 10), Ar(i, 3), Ar(i, 1), Ar(i, 2))
   
8. Next
   
9. End With
   
10. With Sheets("ª«®ÆºÞ±±²M³æ")
    
11. Ar = .UsedRange.Value
    
12. For i = 2 To UBound(Ar, 1)
    
13.    If d.exists(Ar(i, 6)) Then
    
14.      .Cells(i, 1).Resize(, 9) = d(Ar(i, 6)) '²£«~¥X²{¦bª«®Æ«h§ó·s¬°²£«~¸ê®Æ
    
15.       d.Remove Ar(i, 6) '²¾°£¤w¼g¤Jªº¸ê®Æ
    
16.    End If
    
17. Next
    
18. '­Y²£«~¥¼¥X²{©óª«®Æ¡A«h·s¼W¦Üª«®Æ¸ê®Æ§À
    
19. If d.Count > 0 Then .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(d.Count, 9) = Application.Transpose(Application.Transpose(d.items))
    
20. End With
    
21. End Sub

½Æ»s¥N½X

forum01.22.zip (126.27 KB)

¤U¸ü¦¸¼Æ: 6

2014-1-22 16:43

li_hsien

¦^´_ 12# Hsieh


ÁÂÁÂHªO¤jªº¸Ñµª

¤£¹L´ú¸Õ¤F¤@¤U

§Úµo²{¦pªG§Ú¦b"²£«~"¨ºÃä§R°£¤@µ§¡A¦A¦¸°õ¦æ

"ª«®Æ"¨º¨Ã¤£·|§R°£­C

¦n¹³ÁÙ¬O¦³ÂI°ÝÃD

³Â·ÐªO¤jÀ°§Ú¬Ý¬Ý

ÁÂÁÂ:  )

li_hsien

¦^´_ 10# GBKEE

GBªO¤j¡A¦pªG§Ú¤£°µ­«½Æªº³B²z

ª½±µ°µ"²£«~"¸ò"ª«®Æ"ªº·s¼W§R°£­×§ï

§ï¦¨¥H¤U¤è¦¡¥i¦æ¶Ü???

¼Ò¦¡¤@¼Ë¬O¥H"²£«~"¬°¥D
¦pªG
"²£«~"¦³   "ª«®Æ"¦³  «h§â"²£«~"  ©ñ¨ì  "ª«®Æ" ­ì¦³ªº¦ì¸m
"²£«~"µL   "ª«®Æ"¦³  «h§â"ª«®Æ" ¨ºµ§¾ãÄæ§R±¼
"²£«~"¦³   "ª«®Æ"µL  «h§â·s¼W¥X¨Óªº¨ºµ§"²£«~"¸ê°T ·s¼W¨ì"ª«®Æ"ªº³Ì¤U¤è


¦ý§Ú´ú¸Õ´X¦¸¡A¦pªG¦b"²£«~"ªºªí³æ¤¤¥[¤J¤@µ§·sªº

¥i¯àµLªk¦b"ª«®Æ"¤¤Åã¥Ü

¦b³Ì¤UºÝ¼W¥[¦n¹³¤~¤£·|¥X¿ù


³Â·ÐªO¤jÀ°§Ú¬Ý¬Ýµ{¦¡Áٻݰµ«ç¼Ëªº­×§ï

ÁÂÁ§A  :  )

1. Sub Ex2()
   
2.     Dim d As New Collection, AR(1 To 7), i As Integer, Rng As Range, E As Variant
   
3.     On Error Resume Next              'Collection·s¼WªºKEY¦p³Q¨Ï¥Î©Î¦³¿ù»~
   
4.     With Worksheets("²£«~ºÞ±±²M³æ")
   
5.         For i = 2 To .Range("J1").End(xlDown).Row
   
6.             AR(1) = .Range("E" & i)             'PRODUCT ID(A)
   
7.             AR(2) = .Range("F" & i)             'CHILDPARTNUMBER(B)
   
8.             AR(3) = .Range("C" & i)             'MP date(G)
   
9.             AR(4) = .Range("A" & i)             '¶g§O(H)
   
10.             AR(5) = .Range("B" & i)             '§ó·s¶g§O(I)
    
11.             AR(6) = DateDiff("d", Date, AR(3))  '¤u§@¤é(M)
    
12.             AR(7) = .Range("J" & i)             'Product ID & PartNumber(F)
    
13.             d.Add AR, .Range("J" & i).Value
    
14.         Next
    
15.     End With
    
16.     With Worksheets("ª«®ÆºÞ±±²M³æ")
    
17.         For Each E In .Range("F:F").SpecialCells(xlCellTypeConstants).Offset(1)
    
18.             .Range("A" & E.Row) = d(E.Value)(1)
    
19.             .Range("B" & E.Row) = d(E.Value)(2)
    
20.             .Range("G" & E.Row) = d(E.Value)(3)
    
21.             .Range("H" & E.Row) = d(E.Value)(4)
    
22.             .Range("I" & E.Row) = d(E.Value)(5)
    
23.             .Range("M" & E.Row) = d(E.Value)(6)
    
24.             .Range("F" & E.Row) = d(E.Value)(7)
    
25.             If Err = 0 Then                     'ª«®ÆªºID & PartNumber,¦s¦b²£«~ªºID & PartNumber¤¤
    
26.                 d.Remove E.Value                '°£¥h:²£«~ªºID & PartNumber
    
27. 
    
28.             ElseIf Err <> 0 And E <> "" Then    'ª«®ÆªºID & PartNumber,¤£¦s¦b²£«~ªºID & PartNumber¤¤
    
29.                 If Rng Is Nothing Then       '¨úªºÀx¦s®æªº¦ì¸m
    
30.                     Set Rng = E
    
31.                 Else
    
32.                     [color=Red]Set Rng = Union(E, Rng)[/color]
    
33.                     [color=Red]Rng.EntireRow.Delete[/color]
    
34.                 End If
    
35.             End If
    
36.             Err.Clear
    
37.         Next
    
38.         If d.Count > 0 Then                     '¸É¤W:ª«®Æ¨S¦³ªº²£«~ID & PartNumber
    
39.             i = 0
    
40.             With .Range("A1").End(xlDown)
    
41.                 For Each E In d
    
42.                     i = i + 1
    
43.                     .Offset(i).Range("A1") = E(1)
    
44.                     .Offset(i).Range("B1") = E(2)
    
45.                     .Offset(i).Range("G1") = E(3)
    
46.                     .Offset(i).Range("H1") = E(4)
    
47.                     .Offset(i).Range("I1") = E(5)
    
48.                     .Offset(i).Range("M1") = E(6)
    
49.                     .Offset(i).Range("F1") = E(7)
    
50.                 Next
    
51.             End With
    
52.         End If
    
53.     End With

½Æ»s¥N½X

Hsieh

¦^´_ 14# li_hsien
¼Ò¦¡¤@¼Ë¬O¥H"²£«~"¬°¥D
¦pªG
"²£«~"¦³   "ª«®Æ"¦³  «h§â"²£«~"  ©ñ¨ì  "ª«®Æ" ­ì¦³ªº¦ì¸m
"²£«~"µL   "ª«®Æ"¦³  «h§â"ª«®Æ" ¨ºµ§¾ãÄæ§R±¼
"²£«~"¦³   "ª«®Æ"µL  «h§â·s¼W¥X¨Óªº¨ºµ§"²£«~"¸ê°T ·s¼W¨ì"ª«®Æ"ªº³Ì¤U¤è

³o¼Ë¤£´N¥u¬O§â²£«~§R°£­«ÂЪºµ²ªG¦Ó¤w¶Ü¡H

li_hsien

¦^´_ 15# Hsieh

"²£«~"¨ºÃ䪺¤u§@ªíÁÙ¬O»Ý­n«O¯dµÛ

¦]¬°"²£«~"¸ò"ª«®Æ"ªº¸ê°T¤£¤Ó¤@¼Ë

Äæ¦ì¤]¤£ºÉ¬Û¦P

¦ý¦³¨Ç³¡¤À¤@¼Ë

¨º¥¦¥D­n¹ïÀ³ªº¤è¦¡³£¬O¨Ì¾ÚID & PAERTNUMBER


¹ï¤F!!!
¨ä¹ê¸ò¤§«eHª©¤jÀ°§Ú³B²zªº<¨â¤u§@ªí¤ñ¹ï ·s¼W­×§ï>³o½g¬O¤@¼Ëªº

¥u¬O§Ú«á¨ÓÀ³¸Ó¤è«K§@·~©Ò¥H¦h²£¥Í¤F¤@­ÓID & PAERTNUMBER¨Ó¤ñ¹ï

¤£»Ý­n¦n´XÄæ&°_¨Ó¤ñ¹ï


¤£¹L¦]¬°§Ú¥ÎFOR¦A¶]

©Ò¥H¸ê®Æ¶q¦n¤j

·Q´M¨D§Ö³tªº¤ñ¹ï¤è¦¡


³Â·Ð¦U¦ì¤j¤j­Ì   ÁÂÁ  :   )

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??

li_hsien

¦^´_ 17# GBKEE

ÁÂÁªO¤j¦A¦¸À°§Ú­×§ï

§Ú¦A´ú¸Õ¤@¦¸ÁÙ¬O·|¦h§R°£­C

¥H¤U¬O§Ú¥Î¤j¤jµ{¦¡½X­×§ï«áªº

1. Option Explicit
   
2. 
   
3. Sub Ex()
   
4.     Dim d As New Collection, AR(1 To 7), i As Integer, Rng(1 To 2) As Range, E As Variant
   
5.     On Error Resume Next              'Collection·s¼WªºKEY¦p³Q¨Ï¥Î©Î¦³¿ù»~
   
6.     With Worksheets("²£«~ºÞ±±²M³æ")
   
7.         For i = 2 To .Range("J1").End(xlDown).Row
   
8.             AR(1) = .Range("E" & i)             'PRODUCT ID(A)
   
9.             AR(2) = .Range("F" & i)             'CHILDPARTNUMBER(B)
   
10.             AR(3) = .Range("C" & i)             'MP date(G)
    
11.             AR(4) = .Range("A" & i)             '¶g§O(H)
    
12.             AR(5) = .Range("B" & i)             '§ó·s¶g§O(I)
    
13.             AR(6) = DateDiff("d", Date, AR(3))  '¤u§@¤é(M)
    
14.             AR(7) = .Range("J" & i)             'Product ID & PartNumber(F)
    
15.             d.Add AR, .Range("J" & i).Value
    
16.             '*****§ä¥X[²£«~ºÞ±±²M³æ]­«½Æªº[ID & PartNumber]  ****
    
17.             If Err <> 0 Then
    
18.                 Err.Clear
    
19.                 If Rng(1) Is Nothing Then
    
20.                     Set Rng(1) = .Range("J" & i)
    
21.                 Else
    
22.                     Set Rng(1) = Union(.Range("J" & i), Rng(1))
    
23.                 End If
    
24.             End If
    
25.             '*****************************************************
    
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.             If Err = 0 Then                     'ª«®ÆªºID & PartNumber,¦s¦b²£«~ªºID & PartNumber¤¤
    
38.                 d.Remove E.Value                '°£¥h:²£«~ªºID & PartNumber
    
39.             ElseIf Err <> 0 And E <> "" Then    'ª«®ÆªºID & PartNumber,¤£¦s¦b²£«~ªºID & PartNumber¤¤
    
40.                 If Rng(2) Is Nothing Then       '¨úªºÀx¦s®æªº¦ì¸m
    
41.                     Set Rng(2) = E
    
42.                 Else
    
43.                     Set Rng(2) = Union(E, Rng(2))
    
44.                 End If
    
45.             End If
    
46.             Err.Clear
    
47.         Next
    
48.         If d.Count > 0 Then                     '¸É¤W:ª«®Æ¨S¦³ªº²£«~ID & PartNumber
    
49.             i = 0
    
50.             With .Range("A1").End(xlDown)
    
51.                 For Each E In d
    
52.                     i = i + 1
    
53.                     .Offset(i).Range("A1") = E(1)
    
54.                     .Offset(i).Range("B1") = E(2)
    
55.                     .Offset(i).Range("G1") = E(3)
    
56.                     .Offset(i).Range("H1") = E(4)
    
57.                     .Offset(i).Range("I1") = E(5)
    
58.                     .Offset(i).Range("M1") = E(6)
    
59.                     .Offset(i).Range("F1") = E(7)
    
60.                 Next
    
61.             End With
    
62.         End If
    
63.     End With
    
64.    
    
65. '    '********* "²£«~ºÞ±±²M³æ" §R°£­«½Æªº[ID & PartNumber]*******************
    
66. '    If Not Rng(1) Is Nothing Then
    
67. '        If MsgBox("§R°£­«½Æªº[ID & PartNumber]", vbQuestion + vbYesNo, "²£«~ºÞ±±²M³æ") = vbYes Then
    
68. '            Rng(1).EntireRow.Delete
    
69. '        End If
    
70. '    End If
    
71.    
    
72. '    '********* "²£«~ºÞ±±²M³æ" §R°£­«½Æªº[ID & PartNumber]*******************
    
73. '    If Not Rng(1) Is Nothing Then
    
74. '        If MsgBox("§R°£­«½Æªº[ID & PartNumber]", vbQuestion + vbYesNo, "²£«~ºÞ±±²M³æ") = vbYes Then
    
75. '             Worksheets("²£«~ºÞ±±²M³æ").Activate
    
76. '            Stop                                            'µ{¦¡·|°±¤î «öF8¤@¨B¤@¨B°õ¦æ¤U¥h¬Ý¤u§@ªíªº±¡§Î
    
77. '            Rng(1).EntireRow.Select                  '¿ï¨ú­«½ÆªºID
    
78. '            MsgBox Rng(1).EntireRow.Address
    
79. '            Debug.Print Rng(1).EntireRow.Address
    
80. ''            Rng(1).EntireRow.Delete   '¥ýµù¸Ñ±¼¤£§R°£
    
81. '        End If
    
82. '    End If
    
83.    
    
84.    
    
85.     If Not Rng(1) Is Nothing Then
    
86.     '**** §R°£"²£«~"­«½Æªº³¡¤À->Rng(1)
    
87.         If MsgBox("§R°£­«½Æªº[ID & PartNumber]", vbQuestion + vbYesNo, "²£«~ºÞ±±²M³æ") = vbYes Then
    
88.             Rng(1).Interior.Color = vbGreen    '­«½Æªº¼Ðµù¬°ºñ¦â
    
89.             For Each E In Rng(1).Areas
    
90.                 For i = 1 To E.Cells.Count
    
91.                     Set Rng(3) = Rng(1).EntireColumn.Find(E.Cells(i), LookIn:=xlValues)
    
92.                     If Application.Intersect(Rng(1), Rng(3)) Is Nothing Then
    
93.                         Rng(3).Interior.Color = vbRed      '«O¯d²Ä¤@µ§­«½Æªº¼Ðµù¬õ¦â
    
94.                     End If
    
95.                 Next
    
96.             Next
    
97.           '  Rng(1).EntireRow.Delete  ¥ý¤£§R°£¥h¬Ý¬Ý¦³«O¯d¦b­þ¸Ì
    
98.         End If
    
99.     End If
    
100.    
     
101.    
     
102.     '********* "ª«®ÆºÞ±±²M³æ" §R°£­«½Æªº[ID & PartNumber]*******************
     
103.     If Not Rng(2) Is Nothing Then
     
104.         If MsgBox("§R°£­«½Æªº[ID & PartNumber]", vbQuestion + vbYesNo, "ª«®ÆºÞ±±²M³æ") = vbYes Then
     
105.           'Rng(2).EntireRow.Select
     
106.            Rng(2).EntireRow.Delete
     
107.         End If
     
108.     End If
     
109.     MsgBox "Ok"
     
110. End Sub

½Æ»s¥N½X

À³¸Ó¬O³o¼Ë§ï¨S¦³¿ù§a


¦ý§Ú¶]¥X¨Ó"²£«~"¨ºÃä¤@¼Ë¬O¦h§R°£

¥¿±`À³¸Ó³Ñ1206¶µ¦ý§R°£«á«o¥u³Ñ1194¶µ

¦n©_©Ç³á@@


¤j¤j»¡·s¼Wªº³¡¤À

¦]¬°§Úªº"²£«~"¬O¥Ñ¨â±i¤u§@ªí¦X¦Ó¬°¤@ªº

©Ò¥H·s¼W¬O¤À§O¦b¨â±i¤u§@ªí°µªº

©Ò¥H·s¼Wªº¸ê°T¥i¯à·|¦b"²£«~"ªº¤¤¶¡³¡¤À

¤£¬O¦b"²£«~"ªº³Ì¤U¤è



½Ð°Ý¤j¤j

§Ú¯à¥ý³B²z§R°£­«½Æ

¨º³æ¯Â¥u°µ"²£«~","ª«®Æ"¸ê°Tªº·s¼W§R°£­×§ï¶Ü???

³o¼Ë¬O§_¤ñ¸û¨S³o»ò½ÆÂø
(´N¥h°£±¼±Æ°£­«½Æªº¨BÆJ¡A¨ä¾l³£¤@¼Ë)



¥H¤W ³Â·Ð¤j¤j  °Ñ°u  ÁÂÁ  :   )

li_hsien

¦^´_ 17# GBKEE

¤j¤j§A¤]¤Ó¯«©_¤F

¯uªº100µ§¥H¤U´NOK­C@@

¬°¤°»ò·|³o¼Ë°Ú


¤£¹L§Ú¤£¯à¥u¦³³o»ò´Xµ§

¤£ª¾¯à§_§JªA???

GBKEE

¦^´_ 19# li_hsien

   

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

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

¤U¸ü (108.27 KB)

2014-1-24 08:39