p6703

¦Ñ°ÝÃD¤@ª½¥¼¸Ñ¨M¡A¦A¦¸¸ß°Ý°ª¤â¸Ñ´b
GBKEEª©¥D³]­pªº¥¨¶°¥i¨Ì¦U±ø¥ó±N¸ê®ÆCOPYªº¦UÀɮתºÄæ¦ì¤¤¡A¦ý¦]¸Ó³øªí¤¤¤@¨ÇÄæ¦ì³£¤w¦³³]©w¤½¦¡¦Û°Ê®M¨ú¼Æ¾Ú¡A¤p§Ì¬O¥H¤Uµ{¦¡½X¥h®M¨ú­ì¹w³]ªº¤½¦¡¡A¦ý¨ä¤¤¦³¤@­ÓÀÉ®×®M¨ú¦C¼Æ·|¶W¹L«Ü¦h¦C¡]¨Ò¡G­ì·s¸ê®Æ¼W¥[5¦C¡Aµ²ªG°õ¦æ¦¹¥¨¶°«á¨ä¼W¥[¤F´X¦Ê¦C¡^¡A½Ð°Ý¬O§_¦¹¥¨¶°¥i¦A­×§ï®M¨ú·s¼W¥[ªº¦C¼Æ´N¦n¡AÁÂÁÂ...^^
    Range("G2").Select
    Selection.End(xlDown).Select
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & [H2].End(xlDown).Row)
    Range("A1:A" & [H2].End(xlDown).Row).Select

p6703

ÁÙ½ÐGBKEEª©¥DÀ°¦£¬O§_¥i¹F¦¨¤p§Ì»Ý¨Dªº¥\¯à,¥H«K®M¨ú®É§ó¤è«K,ÁÂÁÂ...^^

p6703

GBKEEª©¥D³o´X¤é¨Ï¥Î¦³´X°ÝÃD¦A½Ð±Ð¡A¤´¦A³Â·Ð¤F¡A¥ý¦b¦¹·qÁ¡G

1.¤p§Ì±N­ì­q³æ¸ê®ÆCOPY¨ì§OÀÉ®×°õ¦æ¡A«oµLªk±N¸ê®ÆCOPY¨ì­q³æ³øªí¤¤¡]¦ý¤u§@ªí¦WºÙ§¡¬°SHEET1¡^¡A¥u¯à¦b­ì¦³¥¨¶°ªºÀɮפ¤°õ¦æ¤~·|°Ê§@???
2.·s³øªí¤¤ªºCÄæ§Æ±æ¥i®M¨ú·í¤Ñ¤é´Á¡AG¤ÎJÄæ¦ì­ì³Ì«á¤@Äæ¤w¦³®M¨ú¤½¦¡¡A¦p¦ó±N·s¸ê®Æ©µ¥Î­ì¤½¦¡
3.©µ¦ù¥t¤@°ÝÃD¡A¦p¶È¥u¬O¾ã¦C½Æ»s¡A­ì¥¨¶°¦p¦ó­×§ï???¥i«ö­ì­n¨D¦Û°ÊCOPY¨ì«ü©wªº¤u§@ªí¤¤¡]­ì¤u§@ªí§¡¤w¦³¸ê®Æ¡A¦Û°Ê©¹³Ì«á¤@¦C¶}©l¥[¤W¸Ó·s¼W¸ê®Æ¡^

p6703

·PÁÂGBKEEª©¥D¥¨¶°¤w²Å¦X¤p§Ìªº»Ý¨D¡A¥ý¬ã¨s¬Ý¬Ý¡A¦³°ÝÃD¦A½Ð±Ð¤F¡A¦A¦¸·PÁÂ^^

GBKEE

¦^´_ 3# p6703

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim D As Object, Dwb As String, Ar(1 To 11), Ay(), xi As Integer, K, Wb As Workbook
   
4.     Dim W As Workbook
   
5.     Set D = CreateObject("Scripting.Dictionary")
   
6.     xi = 2
   
7.     With ThisWorkbook.Sheets("SHEET1")
   
8.         Do While .Cells(xi, "M") <> ""
   
9.             Ar(1) = .Cells(xi, "C")                         'Ar(1)->Ar(11) = AÄæ:KÄæ
   
10.             Ar(2) = IIf(.Cells(xi, "A") = "OS" Or .Cells(xi, "A") = "IS", 2, "")                       'Ar(1)->Ar(11) = AÄæ:KÄæ
    
11.             'BÄæ¦ì¨Ì¨Ó·½¸ê®Æ¬°IS©ÎOS§Y¦Û°Ê¶ñ¤J2¡A§_«h¤@«ß¬°ªÅ¥Õ
    
12.             Ar(4) = .Cells(xi, "F")                         '«ü©w¤£³sÄòªºÄæ¦ì ¨ì«ü©w¦ì¸m
    
13.             Ar(5) = .Cells(xi, "J")
    
14.             Ar(6) = .Cells(xi, "B")
    
15.             Ar(8) = .Cells(xi, "D")
    
16.             Ar(9) = .Cells(xi, "E")
    
17.             Ar(11) = .Cells(xi, "H")
    
18.             If Not D.exists(.Cells(xi, "M").Value) Then     '¦r¨åª«¥ó ªºKEY ¤£¦s¦b
    
19.                 D(.Cells(xi, "m").Value) = Array(Ar)        '¦r¨åª«¥óªºitem «ü©w¬°°}¦C
    
20.             Else                                            '¦r¨åª«¥óªºKEY¦s¦b
    
21.                 Ay = D(.Cells(xi, "M").Value)               'Ay=¦r¨åª«¥óªºITEM
    
22.                 ReDim Preserve Ay(UBound(Ay) + 1)           '°}¦Cªº¤¸¯À¤º®e¤£ÅÜ,·s¼W¤@­Ó¤¸¯À
    
23.                 Ay(UBound(Ay)) = Ar                         '·s¼W¤@­Ó¤¸¯À «ü©w¬° Ar
    
24.                 D(.Cells(xi, "m").Value) = Ay               '¦r¨åª«¥óªºITEM=Ay°}¦C
    
25.             End If
    
26.             xi = xi + 1
    
27.         Loop
    
28.     End With
    
29.     For Each K In D.keys
    
30.         If K = 1202 Then Dwb = "A.xls"             '«ü©wÀÉ®×
    
31.         If K = 1205 Then Dwb = "B.xls"
    
32.         If K = 1206 Then Dwb = "C.xls"
    
33.         Set Wb = Nothing
    
34.         'Nothing ÃöÁä¦r¬O¥Î¨Ó±N¤@­Óª«¥óÅܼƱq¤@­Ó¹ê»Úªºª«¥óùؤÀÂ÷¶}¨Ó¡C¨Ï¥Î Set ³¯­z¦¡¥i«ü©w Nothing µ¹ª«¥óÅܼÆ
    
35.         For Each W In Workbooks
    
36.             If W.Name = Dwb Then Set Wb = Workbooks(Dwb): Exit For                   'Àɮצs¦b ³]©wÅܼÆ
    
37.         Next        '
    
38.         If Wb Is Nothing Then Set Wb = Workbooks.Open(ThisWorkbook.Path & "\" & Dwb) 'Àɮפ£¦s¦b ³]©wÅܼÆ
    
39.         xi = Application.CountA(Wb.Sheets(1).Range("A:A")) + 1
    
40.         Ay = Application.Transpose(Application.Transpose(D(K)))
    
41.         Wb.Sheets(1).Cells(xi, "A").Resize(UBound(Ay, 1), UBound(Ay, 2)) = Ay
    
42.         Wb.Close True                                           'Ãö³¬ÀÉ®×: ¦sÀÉ
    
43.     Next
    
44. End Sub

½Æ»s¥N½X

PS ½Ð«ö¦^ÂÐÁä ,½×¾Â·|³qª¾§Ú¦³¦^ÂЪº©«¤l

p6703

·PÁÂGBKEEª©¥D¡A¤p§Ì°õ¦æ«á¦³¤G°ÝÃD½Ð°Ý¡G

1.¥¼¶}±ÒÀɮת¬ªp¤U¡A·|³y¦¨¶]¥X¿ù»~°T®§¡G°õ¦æ¶¥¬q¿ù»~ 9':°}¦C¯Á¤Þ¶W¥X½d³ò¡A¬O§_¥i¦A³]©w§Y¨Ï¥¼¶}±Ò¤]¥i¦Û°Ê±N¸ê®Æ¼g¤J¡]©Î§P©w¥¼¶}¦Û°Ê¶}±Ò??¡^
2.BÄæ¦ì¨Ì¨Ó·½¸ê®Æ¬°IS©ÎOS§Y¦Û°Ê¶ñ¤J2¡A§_«h¤@«ß¬°ªÅ¥Õ¡]­p¹º­û¬°1205ªº¦³¤@µ§OS¤ÎIS¡A§Æ±æ¥i©óBÄæ¦Û°Ê¶ñ¤J2¡^

Ãþ§O        ­q³æ¸¹½X        ¶µ¦¸        ®Æ¸¹        ¥¼µ²¼Æ¶q        ¤U³æ¤é        ¥æ´Á¦^ÂÐ¤é        ¨ì´Á¤é        ¤Ñ¼Æ        «È¤á¥N½X        «È¤á¦WºÙ        ®w¦s¶q        ­pµe­û
OS        AA12354        1        B        250,000.00        2012/7/8                2012/8/10                5465798                        1205
IS        AB123458        4        AA        158,789.00        2012/7/5                2012/8/13                4986798                        1205

GBKEE

¦^´_ 1# p6703
¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim D As Object, Ar(1 To 11), Ay(), xi As Integer, K, Wb As Workbook
   
4.     Set D = CreateObject("Scripting.Dictionary")
   
5.     xi = 2
   
6.     With ThisWorkbook.Sheets("SHEET1")
   
7.         Do While .Cells(xi, "M") <> ""
   
8.             Ar(1) = .Cells(xi, "C")                         'Ar(1)->Ar(11) = AÄæ:KÄæ
   
9.             Ar(4) = .Cells(xi, "F")                         '«ü©w¤£³sÄòªºÄæ¦ì ¨ì«ü©w¦ì¸m
   
10.             Ar(5) = .Cells(xi, "J")
    
11.             Ar(6) = .Cells(xi, "B")
    
12.             Ar(8) = .Cells(xi, "D")
    
13.             Ar(9) = .Cells(xi, "E")
    
14.             Ar(11) = .Cells(xi, "H")
    
15.             If Not D.exists(.Cells(xi, "M").Value) Then     '¦r¨åª«¥ó ªºKEY ¤£¦s¦b
    
16.                 D(.Cells(xi, "m").Value) = Array(Ar)        '¦r¨åª«¥óªºitem «ü©w¬°°}¦C
    
17.             Else                                            '¦r¨åª«¥óªºKEY¦s¦b
    
18.                 Ay = D(.Cells(xi, "M").Value)               'Ay=¦r¨åª«¥óªºITEM
    
19.                 ReDim Preserve Ay(UBound(Ay) + 1)           '°}¦Cªº¤¸¯À¤º®e¤£ÅÜ,·s¼W¤@­Ó¤¸¯À
    
20.                 Ay(UBound(Ay)) = Ar                         '·s¼W¤@­Ó¤¸¯À «ü©w¬° Ar
    
21.                 D(.Cells(xi, "m").Value) = Ay               '¦r¨åª«¥óªºITEM=Ay°}¦C
    
22.             End If
    
23.             xi = xi + 1
    
24.         Loop
    
25.     End With
    
26.     For Each K In D.keys
    
27.         If K = 1202 Then Set Wb = Workbooks("A.xls")             'Àɮפw¶}±Ò
    
28.         'If K = 1202 Then Set Wb = Workbooks.Open("¸ô®| \A.xls") 'ÀÉ®×¥¼¶}±Ò
    
29.         If K = 1205 Then Set Wb = Workbooks("B.xls")
    
30.         If K = 1206 Then Set Wb = Workbooks("C.xls")
    
31.         xi = Application.CountA(Wb.Sheets(1).Range("A:A")) + 1
    
32.         Ay = Application.Transpose(Application.Transpose(D(K)))
    
33.         Wb.Sheets(1).Cells(xi, "A").Resize(UBound(Ay, 1), UBound(Ay, 2)) = Ay
    
34.         Wb.Close True                                           'Ãö³¬ÀÉ®×: ¦sÀÉ
    
35.     Next
    
36. End Sub

½Æ»s¥N½X