¨Ì«ü©wÄæ¦ì¤¤ªº¸ê®Æ¦Û°Ê§P©w¿é¤J¹ïÀ³ªºÀɮ׸ê®Æ¤¤???

p6703

¤p§Ì©ó¤u§@·|¦³¤@­q³æ©ú²Ó¤u§@ªí¡A§Æ±æ¥i¨Ì­p¹º­û¡A¤À§O±N¨ä¸ê®Æ½Æ»s¦ÜA,B,C¤TÀɮפ¤¡]1202-->AÀÉ¡A1205-->BÀÉ¡A1206-->CÀÉ¡^¡AA~CÀɮפ¤­ì§Y¤w¦³­q³æ¸ê®Æ¡A·s¼Wªº­q³æ¸ê®Æ»Ý·s¼W¥[¤J¡]¨Ò¡G­ìAÀɮפ¤¤w¦³100¦C¡A·s¥[¤Jªº­q³æ¸ê®Æ»Ý¦Û°Ê§P©w±q101¦C¦Û°Ê¿é¤J¡^

¦ý«D¾ã¦C½Æ»s¡A¶È¦³³¡¥÷Äæ¦ì¸ê®Æ»Ý·s¼W¦Ü·s³øªí¡]¦p¤U¡A·s³øªí¤¤ªºC,G,JÄæ¦ì¬°¦Û¦æ¿é¤J¡ABÄæ¦ì¨Ì¨Ó·½¸ê®Æ¬°IS©ÎOS§Y¦Û°Ê¶ñ¤J2¡A§_«h¤@«ß¬°ªÅ¥Õ¡^

¦p¦ó¥H¥¨¶°§Ö³t¹F¦¨¦¹¤@¥Ø¼Ð¡A½Ð¦U¥ý±Ð«ü±Ð¡A¤p§Ì¦b¦¹¥ý«ôÁ¤F:lol :lol

¨Ó·½¸ê®ÆÄæ¦ì                                                                               
C                        F        J        B                D        E                H
·s³øªíÄæ¦ì                                                                               
A        B        C        D        E        F        G        H        I        J        K

¸ê®Æ.rar (7.72 KB)

¤U¸ü¦¸¼Æ: 26

2012-7-11 09:13

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

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

¦^´_ 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¥¨¶°¤w²Å¦X¤p§Ìªº»Ý¨D¡A¥ý¬ã¨s¬Ý¬Ý¡A¦³°ÝÃD¦A½Ð±Ð¤F¡A¦A¦¸·PÁÂ^^

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

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

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

Hsieh

¦^´_ 8# p6703

1. Sub Ex()
   
2. Dim Ws(), A As Range, B As Range, s%, bs$, w As Window
   
3. For Each w In Windows
   
4. ReDim Preserve Ws(s)
   
5. Ws(s) = w.Caption
   
6. s = s + 1
   
7. Next
   
8. With ThisWorkbook.Sheets(1)
   
9.    For Each A In .Range(.[M2], .[M2].End(xlDown))
   
10.      bs = IIf(A = 1202, "A.xls", IIf(A = 1205, "B.xls", IIf(A = 1206, "C.xls", "")))
    
11.      If IsError(Application.Match(bs, Ws, 0)) Then Workbooks.Open ThisWorkbook.Path & "\" & bs: ReDim Preserve Ws(s): Ws(s) = bs: s = s + 1
    
12.      With Workbooks(bs)
    
13.      Set B = .Sheets(1).[A65536].End(xlUp).Offset(1)
    
14.      ar = Array(A.Offset(, -10).Value, IIf(A.Offset(, -12) = "IS" Or A.Offset(, -12) = "IN", 2, ""), Date, A.Offset(, -7).Value, A.Offset(, -3).Value, A.Offset(, -11).Value, B.Offset(, 6).FormulaLocal, A.Offset(, -9).Value, A.Offset(, -8).Value, B.Offset(, 9).FormulaLocal, A.Offset(, -5).Value)
    
15.      B.Resize(, 11).Value = ar
    
16.      End With
    
17.    Next
    
18. End With
    
19. End Sub

½Æ»s¥N½X

p6703

·PÁÂHsieh ª©¥D¡A¤p§Ì¦³¤@°ÝÃD¦A½Ð°Ý¡A¦pªG©óA~C³øªí­ì©T©wÄæ¦ì§Y¦³¤½¦¡¡A¦p¦ó¦b±N·s¸ê®ÆCOPY¨ì³øªí®É¡A±N¦UÄæ¦ìªº¤½¦¡ª½±µ©µ¦ù®M¥Î????

­q³æ³øªí¤¤¦³¤½¦¡ªºÄæ¦ì¡GG¡BJ¡BN¡BP¡BR¡BS¡BW

ªþ¥ó¤¤ªºAÀɮצ³¹w³]¤½¦¡...

¸ê®Æ.rar (24.63 KB)

¤U¸ü¦¸¼Æ: 8

2012-9-26 08:45