GBKEE

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

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Ar, E As Variant, xi As Integer, xlCsv As String, xlPath As String
   
4.     Dim Sh(1 To 2) As Worksheet
   
5.     xlPath = ThisWorkbook.Path & "\"                                '->­×§ï¬°¥¿½TªºÀɮ׸ô®|
   
6.     Set Sh(1) = Workbooks.Open(xlPath & "test21.csv").Sheets(1)
   
7.     Set Sh(2) = Sh(1).Parent.Sheets.Add
   
8.     Sh(1).Cells.Copy Sh(2).Cells(1)                                 '½Æ»s test21.csv ªº¸ê®Æ                             '
   
9.     xlCsv = Dir(xlPath & "*.Csv")                                   '´M§ä *.CsvÀÉ®×
   
10.     Do While xlCsv <> "" And LCase(xlCsv) <> "test21.csv"
    
11.         With Workbooks.Open(xlPath & xlCsv).Sheets(1)
    
12.             Sh(2).Cells(Rows.Count, 1).End(xlUp).Offset(2) = "[*" & xlCsv & "*]"
    
13.             .[a1].CurrentRegion.Copy Sh(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
    
14.             .Parent.Close 0
    
15.         End With
    
16.         xlCsv = Dir
    
17.     Loop
    
18.      With Sh(2)
    
19.         .Activate
    
20.         For Each E In ActiveWorkbook.Names
    
21.             '§R°£©Ò¦³¤w©w¸qªº¦WºÙ ¥HÁקK : ©w¸qªº¦WºÙ¤¤¦³¤£¦bªº *.Csv
    
22.              E.Delete
    
23.         Next
    
24.        '*** ³B¸Ì ¤w¶×¤Jªº *.Csv  *********
    
25.         Ar = .Range("a:a").Value
    
26.        .Range("a:a").Replace "[*.*]", "=1/0"                                '[*.Csv] ´À¥N¬°¿ù»~­È
    
27.        .Range("a:a").SpecialCells(xlCellTypeFormulas, xlErrors).Select      '¿ï¾Ü¦³¿ù»~­ÈªºÀx¦s®æ
    
28.         .Range("a:a").Value = Ar                                            '½Æ­ì­ì¨Óªº­È
    
29.         For Each E In Selection
    
30.             E.CurrentRegion.Name = Replace(Replace(E, "*]", ""), "[*", "")
    
31.             '¨C¤@Àx¦s®æªº©µ¦ù½d³ò: ©w¸q¦WºÙ  *.Csv
    
32.         Next
    
33.         '****************************
    
34.         Sh(1).Cells.Clear      'test21.csv.Sheets(1) :²M°£©Ò¦³¸ê®Æ ­«·s¶×¤J±Æ§Ç«áªº*.Csv
    
35.         For Each E In ActiveWorkbook.Names             '©w¸q¦WºÙ :·|¦Û°Ê±Æ§Ç¦WºÙ
    
36.             xi = Sh(1).Cells(Rows.Count, 1).End(xlUp).Row
    
37.             xi = IIf(xi = 1, 1, xi + 2)
    
38.             Range(E.Name).Copy Sh(1).Cells(xi, 1)
    
39.             xi = Sh(1).Cells(Rows.Count, 1).End(xlUp).Row
    
40.             Sh(1).Cells(xi + 2, 1) = "[*div*]"
    
41.         Next
    
42.         Application.DisplayAlerts = False
    
43.         .Delete                                         '§R°£¤u§@ªí
    
44.         Application.DisplayAlerts = True
    
45.     End With
    
46.     '*****  ´ú¸Õ ¦¨¥\«á ¸Ñ°£µù¸Ñ ¥i¦sÀÉ
    
47.     'Sh(1).Parent.Close True
    
48. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 3# luke
BB-1.csv  ->  BB_1.csv

GBKEE

¦^´_ 5# luke

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Sh(1 To 2) As Worksheet, Ar, E As Variant, xlCsv As String, xlPath As String
   
4.     Dim xi As Integer, xR As Integer, xF As Integer
   
5.     xlPath = ThisWorkbook.Path & "\"                                                '->­×§ï¬°¥¿½TªºÀɮ׸ô®|
   
6.     Set Sh(1) = Workbooks.Open(xlPath & "test21.csv").Sheets(1)
   
7.     Set Sh(2) = Sh(1).Parent.Sheets.Add
   
8.     Sh(1).Cells.Copy Sh(2).Cells(1)                                                 '½Æ»s test21.csv ªº¸ê®Æ                          '
   
9.     xlCsv = Dir(xlPath & "*.Csv")                                                   '´M§ä *.CsvÀÉ®×
   
10.     Do While xlCsv <> "" And LCase(xlCsv) <> "test21.csv"
    
11.      With Workbooks.Open(xlPath & xlCsv).Sheets(1)
    
12.            Sh(2).Cells(Sh(2).Rows.Count, 1).End(xlUp).Offset(2) = "[*" & xlCsv & "*]"
    
13.            .[a1].CurrentRegion.Copy Sh(2).Cells(Sh(2).Rows.Count, 1).End(xlUp).Offset(1)  '½Æ»s *.Csvªº¸ê®Æ
    
14.            .Parent.Close 0
    
15.      End With
    
16.      xlCsv = Dir
    
17.     Loop
    
18.     Sh(1).Cells.Clear     'test21.csv.Sheets(1) ²M°£©Ò¦³¸ê®Æ: ¤w³Æ­«·s¶×¤J±Æ§Ç«áªº*.Csv
    
19.     '*** ³B¸Ì ¤w¶×¤Jªº *.Csv*********
    
20.     With Sh(2)
    
21.         .Activate
    
22.         Ar = .Range("a:a").Value
    
23.         .Range("a:a").Replace "[*.*]", "=1/0"                                       '[*.Csv] ´À¥N¬°¿ù»~­È
    
24.         .Range("a:a").SpecialCells(xlCellTypeFormulas, xlErrors).Name = "ÀɦW"      '±N¦³¿ù»~­ÈªºÀx¦s®æ ©w¸q¦WºÙ
    
25.         .Range("a:a").Value = Ar                                                    '½Æ­ì­ì¨Óªº­È
    
26.         With .Columns(Columns.Count)
    
27.             [ÀɦW].Copy .Cells(1)
    
28.             .Sort Key1:=.Range("a1"), Order1:=xlAscending, Header:=xlGuess          '±Æ§Ç[ÀɦW]
    
29.             xR = 1
    
30.             Do While .Cells(xR) <> ""                                               '¶×¤J "ÀɦW"¸ê®Æ
    
31.                 xF = Application.Match(.Cells(xR), .Parent.Columns(1), 0)           '´M§ä "ÀɦW"
    
32.                 xi = Sh(1).Cells(Sh(1).Rows.Count, 1).End(xlUp).Row
    
33.                 xi = IIf(xi = 1, 1, xi + 2)                                         '²Ä¤G­Ó[*.Csv]¥H«á ¶·¦A©¹¤U¦ì²¾¨ì2¦C
    
34.                 .Parent.Cells(xF, 1).CurrentRegion.Copy Sh(1).Cells(xi, 1)
    
35.                 xi = Sh(1).Cells(Sh(1).Rows.Count, 1).End(xlUp).Row
    
36.                 Sh(1).Cells(xi + 2, 1) = "[*div*]"
    
37.                 xR = xR + 1
    
38.             Loop
    
39.         End With
    
40.         Application.DisplayAlerts = False
    
41.         .Delete                                      '§R°£¤u§@ªí
    
42.         Application.DisplayAlerts = True
    
43.     End With
    
44.     '*****´ú¸Õ ¦¨¥\«á ¸Ñ°£µù¸Ñ ¥i¦sÀÉ
    
45.     'Sh(1).Parent.Close True
    
46. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 7# luke
ª©¥»ªº°ÝÃD
6#µ{¦¡½X¥H§ó·s ¸Õ¸Õ¬Ý

GBKEE

¦^´_ 10# luke
7# ªº°ÝÃD ¬O2003 ¥H¤Wªºª©¥» ¨Ï¥ÎEnd ÄÝ©Ê,¦p¦³­pºâ  Rows.Count  ©Î Columns.Count ¶·«ü©ú¥¦ªº¤÷¼hª«¥ó
Sh(1).Rows.Count  ©Î Sh(1).Columns.Count
10# ªº°ÝÃD ­×¥¿¥ÎFind ¨ú¥N Match §ä¨ì ¯u¥¿ªº¦r¦ê ¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Sh(1 To 2) As Worksheet, Ar, E As Variant, xlCsv As String, xlPath As String
   
4.      Dim xi As Integer, xR As Integer, xF As Range, xlRowsCount As Long
   
5.     xlRowsCount = ActiveSheet.Rows.Count
   
6.     xlPath = ThisWorkbook.Path & "\"                                                '->­×§ï¬°¥¿½TªºÀɮ׸ô®|
   
7.     Set Sh(1) = Workbooks.Open(xlPath & "test21.csv").Sheets(1)
   
8.     Set Sh(2) = Sh(1).Parent.Sheets.Add                                             '·s¼W¤u§@ªí§@¬° ¸ê®Æ¼È¦s
   
9.     Sh(1).Cells.Copy Sh(2).Cells(1)                                                 '½Æ»s test21.csv ªº¸ê®Æ                          '
   
10.     xlCsv = Dir(xlPath & "*.Csv")                                                   '´M§ä *.CsvÀÉ®×
    
11.     Do While xlCsv <> "" And LCase(xlCsv) <> "test21.csv"
    
12.      With Workbooks.Open(xlPath & xlCsv).Sheets(1)
    
13.            Sh(2).Cells(xlRowsCount, 1).End(xlUp).Offset(2) = "[*" & xlCsv & "*]"
    
14.            .[a1].CurrentRegion.Copy Sh(2).Cells(xlRowsCount, 1).End(xlUp).Offset(1)  '½Æ»s *.Csvªº¸ê®Æ
    
15.            .Parent.Close 0
    
16.      End With
    
17.      xlCsv = Dir
    
18.     Loop
    
19.     Sh(1).Cells.Clear     'test21.csv.Sheets(1) ²M°£©Ò¦³¸ê®Æ: ¤w³Æ­«·s¶×¤J±Æ§Ç«áªº*.Csv
    
20.     '*** ³B¸Ì ¤w¶×¤Jªº *.Csv*********
    
21.     With Sh(2)
    
22.         .Activate
    
23.         Ar = .Range("a:a").Value
    
24.         .Range("a:a").Replace "[*.*]", "=1/0"                                       '[*.Csv] ´À¥N¬°¿ù»~­È
    
25.         .Range("a:a").SpecialCells(xlCellTypeFormulas, xlErrors).Name = "ÀɦW"      '±N¦³¿ù»~­ÈªºÀx¦s®æ ©w¸q¦WºÙ
    
26.         .Range("a:a").Value = Ar                                                    '½Æ­ì­ì¨Óªº­È
    
27.         With .Columns(Columns.Count)
    
28.             [ÀɦW].Copy .Cells(1)
    
29.             .Sort Key1:=.Range("a1"), Order1:=xlAscending, Header:=xlNo             '±Æ§Ç[ÀɦW]
    
30.             xR = 1
    
31.             Do While .Cells(xR) <> ""                                               '¶×¤J "ÀɦW"¸ê®Æ
    
32.                Set xF = .Parent.Columns(1).Find(.Cells(xR).Text, LookAT:=xlWhole)   '´M§ä "ÀɦW"
    
33.                 xi = Sh(1).Cells(xlRowsCount, 1).End(xlUp).Row
    
34.                 xi = IIf(xi = 1, 1, xi + 2)                                         '²Ä¤G­Ó[*.Csv]¥H«á ¶·¦A©¹¤U¦ì²¾¨ì2¦C
    
35.                 xF.CurrentRegion.Copy Sh(1).Cells(xi, 1)
    
36.                 xi = Sh(1).Cells(xlRowsCount, 1).End(xlUp).Row
    
37.                 Sh(1).Cells(xi + 2, 1) = "[*div*]"
    
38.                 xR = xR + 1
    
39.             Loop
    
40.         End With
    
41.         Application.DisplayAlerts = False
    
42.         .Delete                                                                      '§R°£¸ê®Æ¼È¦s¤u§@ªí
    
43.         Application.DisplayAlerts = True
    
44.     End With
    
45.     '*****´ú¸Õ ¦¨¥\«á ¸Ñ°£µù¸Ñ ¥i¦sÀÉ
    
46.     'Sh(1).Parent.Close True
    
47. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 14# luke
±Æ§Ç±¡§ÎÅܱo«Ü¿ù¶Ã
¥i¥H¬Ý¬Ý¶Ü?

GBKEE

¦^´_ 17# luke
Sh(1).Parent.Close True
Sh(1).Parent.SaveAs Filename:="D:\TEST21OK.txt", FileFormat:=xlUnicodeText, CreateBackup:=False

ActiveWorkbook.SaveAs fd & "µ²ªG\" & "TEST21OK.csv", 6
ActiveWorkbook.SaveAs  "D:\TEST21OK.txt", FileFormat:=xlUnicodeText, CreateBackup:=False

GBKEE

¦^´_ 20# luke

1. Option Explicit
   
2. Sub §RÀɦW()
   
3.     Dim xi As Integer
   
4.     With Workbooks("TEST21OK.CSV").Sheets(1)
   
5.         .[A:A].Replace "[*]", "=1/0"
   
6.         .Range("A:A").SpecialCells(xlCellTypeFormulas, xlErrors).Name = "xx"
   
7.         .Range("xx").EntireRow.Delete
   
8.         .Range("a:a").SpecialCells(xlCellTypeBlanks).Name = "xx"
   
9.         For xi = 1 To .Range("xx").Areas.Count - 1
   
10.             .Range("xx").Areas(xi).Cells(1).EntireRow.Delete
    
11.          Next
    
12.     End With
    
13. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 22# luke

1. Option Explicit
   
2. Sub ©îÀÉ()
   
3.     Dim Ar(), MyPath As String, E As Range, Rng As Range, xlFileName As String
   
4.     Dim ArFile(), Msg As String
   
5.      'CurDir  ¶Ç¦^¤@­Ó Variant (String)¡A¥Î¨Ó¥Nªí¥Ø«eªº¸ô®|¡C
   
6.     MyPath = CurDir & "\"  '¦Û¦æ­×§ï¥¿½T¸ô®|¡C
   
7.     If Dir(MyPath & "*.csv") <> "" Then Kill MyPath & "*.csv"   '§R°£¥Ø«eªº¸ô®|¤Uªº.cgs ÀÉ®×
   
8.     With Workbooks("TEST21.csv").Sheets(1)
   
9.         Ar = .Range("a:a").Value
   
10.         .Range("a:a").Replace "[*.*]", "=1/0"                                       '[*.*] ´À¥N¬°¿ù»~­È
    
11.         .Range("a:a").SpecialCells(xlCellTypeFormulas, xlErrors).Name = "xx"        '©w¸q¦WºÙ: ¿ù»~­ÈªºÀx¦s®æ
    
12.         .Range("a:a").Value = Ar
    
13.         For Each E In .[XX]
    
14.             Set Rng = E.CurrentRegion
    
15.             Set Rng = .Range(E.Cells(2, 1), Rng.Cells(Rng.Rows.Count, Rng.Columns.Count))
    
16.             xlFileName = Replace(Replace(E, "[*", ""), "*]", "")
    
17.             With Workbooks.Add(1)
    
18.                 Rng.Copy .Sheets(1).[a1]
    
19.                 .SaveAs MyPath & xlFileName, xlUnicodeText
    
20.                 .Close 0
    
21.             End With
    
22.          Next
    
23.          .Parent.Close 0
    
24.     End With
    
25. End Sub

½Æ»s¥N½X