[µo°Ý] VBAµ{¦¡ ¶}±Ò¤@­Ó¬Û¦PÀɦW¤£¦PÀÉ®×

èªÎ¯Ì¦Ï

©êºp·Q¸ß°Ý¦U¦ì:
¦p¦ó¥i¥H¥ý¶}±Ò¤@­Ó¬Û¦PÀɦW¤£¦PÀɮסA±N¸ê®Æ³B²z«á¥t¦s¤@­Ó·sÀɮסA¤§«á¶i¦æ½ü°j¡C
¥Ø«e¤w¦³¦¨¥\¶}±Ò¡A¦ý¥L·|«ö·Ó¸ê®Æ§¨¸Ì­±ªº¤ù¼Æ¥þ¼Æ¶}±Ò

¥H¤U¬O§Úªºvbaµ{¦¡:
   Sub A¶}±ÒÀÉ®×()

    Dim lrow As Long
    Dim mFile As String
    Dim Filename As String
   
    mFile = Dir(ThisWorkbook.Path & "\csvÀÉ\" & "*.csv")
    Do While mFile <> ""
    Workbooks.Open Filename:=ThisWorkbook.Path & "\csvÀÉ\" & mFile
    mFile = Dir()
   
    mFile = Dir(ThisWorkbook.Path & "\TXTÀÉ\" & "*.txt")
    Do While mFile <> ""
    Workbooks.Open Filename:=ThisWorkbook.Path & "\TXTÀÉ\" & mFile
    mFile = Dir()
    Loop
    Loop

End Sub
¦A³Â·ÐÀ°§Ú½T»{¤Î­×§ï...ÁÂÁÂ~~

lee88

1. Sub Ex_Main()
   
2.     Dim Msg As Variant
   
3.     Àˬd¸ê®Æ§¨
   
4.     Application.ScreenUpdating = False
   
5.     Application.StatusBar = "            µ{¦¡°õ¦æ¤¤...................."
   
6.     Csv_File = Dir(Csv_Path & "\*.csv")
   
7.     Msg = Csv_File
   
8.     Do While Csv_File <> ""
   
9.         Txt_File = Txt_Path & "\" & Split(Csv_File, ".")(0) & ".txt"                    '­×§ïcsv °ÆÀɦW ¬°txt
   
10.         If CreateObject("Scripting.FileSystemObject").FileExists(Txt_File) = False Then MsgBox "§ä¤£¨ì " & vbLf & Txt_File & vbLf & "Àˬd«á ­«·s°õ¦æµ{¦¡!": End
    
11.         Set WB = Workbooks.Open(Csv_Path & Csv_File)
    
12.         TXT½Æ»s¦ÜCSV
    
13.         Csv_File = Dir()
    
14.         Msg = Msg & vbLf & Csv_File
    
15.     Loop
    
16.     Application.StatusBar = False
    
17.     Application.ScreenUpdating = True
    
18.    '**********¥[¤W³oIf §PÂ_µ{¦¡½X ,µ{¦¡·|§¹¾ã¨Ç*****************
    
19. If Msg <> "" Then
    
20.         Msg = Split(Msg, vbLf)
    
21.         MsgBox Join(Msg, vbLf) & "§¹¦¨TXT½Æ»s¦ÜCSV  " & UBound(Msg) & " ­ÓÀÉ®×"
    
22.     Else
    
23.         MsgBox "¨S¦³¥ô¦óTXTÀɽƻs¦ÜCSVÀÉ"
    
24.     End If
    
25. '************************************************
    
26. End Sub

½Æ»s¥N½X

¦^´_ 12# lee88

lee88

TXT¸ê®Æ½Æ»s¨ìCsvªºµ{¦¡½X¹ï¶Ü!

1. Option Explicit
   
2. Dim WB As Workbook, Csv_File As String, Txt_File As String, Txt_Path As String, Csv_Path As String, Save_Path As String
   
3. Sub Ex_Main()
   
4.     Dim Msg As Variant
   
5.     Àˬd¸ê®Æ§¨
   
6.     Application.ScreenUpdating = False
   
7.     Application.StatusBar = "            µ{¦¡°õ¦æ¤¤...................."
   
8.     Csv_File = Dir(Csv_Path & "\*.csv")
   
9.     Msg = Csv_File
   
10.     Do While Csv_File <> ""
    
11.         Txt_File = Txt_Path & "\" & Split(Csv_File, ".")(0) & ".txt"                    '­×§ïcsv °ÆÀɦW ¬°txt
    
12.         If CreateObject("Scripting.FileSystemObject").FileExists(Txt_File) = False Then MsgBox "§ä¤£¨ì " & vbLf & Txt_File & vbLf & "Àˬd«á ­«·s°õ¦æµ{¦¡!": End
    
13.         Set WB = Workbooks.Open(Csv_Path & Csv_File)
    
14.         TXT½Æ»s¦ÜCSV
    
15.         Csv_File = Dir()
    
16.         Msg = Msg & vbLf & Csv_File
    
17.     Loop
    
18.     Application.StatusBar = False
    
19.     Application.ScreenUpdating = True
    
20.     Msg = Split(Msg, vbLf)
    
21.     MsgBox Join(Msg, vbLf) & "§¹¦¨TXT½Æ»s¦ÜCSV  " & UBound(Msg) & " ­ÓÀÉ®×"
    
22. End Sub
    
23. Private Sub Àˬd¸ê®Æ§¨()
    
24.     Dim Msg As String
    
25.     Save_Path = ThisWorkbook.Path & "\Test\"                     'TXT½Æ»s¦ÜCSV  ¦sÀɪº¸ê®Æ§¨
    
26.     Csv_Path = ThisWorkbook.Path & "\csvÀÉ\"                     'csvÀÉÀɪº¸ê®Æ§¨
    
27.     Txt_Path = ThisWorkbook.Path & "\TXTÀÉ\"                     'TXTÀɪº¸ê®Æ§¨
    
28.     If Dir(Save_Path, vbDirectory) = "" Then
    
29.          If MsgBox("«Ø¥ß " & Save_Path & "  ¸ê®Æ§¨", vbYesNo) = vbYes Then
    
30.             MkDir (Save_Path)
    
31.          End If
    
32.     End If
    
33.     If Dir(Csv_Path, vbDirectory) = "" Then Msg = "§ä¤£¨ì " & Csv_Path
    
34.     If Dir(Txt_Path, vbDirectory) = "" Then Msg = Msg & vbLf & "§ä¤£¨ì " & Txt_Path
    
35.     If Msg <> "" Then MsgBox Msg & vbLf & "Àˬd«á ­«·s°õ¦æµ{¦¡!": End
    
36. End Sub
    
37. Private Sub TXT½Æ»s¦ÜCSV()
    
38.     Dim Sh As Worksheet, Rng As Range
    
39.     Set Sh = Workbooks.Open(Txt_File).Sheets(1)                              '¶}±ÒTXTªºSheets(1)
    
40.     Set Rng = WB.Sheets(1).Range("a1").End(xlDown).Offset(1)   'TXT¸ê®Æ½Æ»s¨ìCsvªº«ü©w¦ì¸m
    
41.     If Rng.Row = Rows.Count Then Set Rng = WB.Sheets(1).Range("a1")
    
42.     '«ü©w¦ì¸mªºRow= Rows.Count  **«ü©w¦ì¸m¦bÀɮש³³¡®É --AÄ椤¨S¦³¸ê®Æ
    
43.     With Sh.Range("A1")                     '¸ê®Æ­åªRAÄæ  -,,,-> Comma:=True
    
44.         .CurrentRegion.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    
45.             TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    
46.             Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
    
47.             :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    
48.         .CurrentRegion.Copy Rng    '**TXT¸ê®Æ½Æ»s¨ìCsv
    
49.     End With
    
50.     Sh.Parent.Close False                                  'Sh(Worksheet).Parent(¤÷¼h-Workbook)Ãö³¬
    
51.     If CreateObject("Scripting.FileSystemObject").FileExists(Save_Path & Csv_File) Then Kill Save_Path & Csv_File
    
52.         '**CreateObject("Scripting.FileSystemObject").FileExists=True **ªíÀɮצs¦b,¬G°õ¦æ  Kill
    
53.     With WB
    
54.         .SaveAs Save_Path & Csv_File               '-Workbook¥t¦s\Test\ ªº CsvÀÉ
    
55.         '****   FileExists=True **  .SaveAs ·|´£¥Ü¬O§_¨ú¥N­ìÀÉ®×--   µ{¦¡¼È®É¤¤Â_°õ¦æ
    
56.         .Close True
    
57.     End With
    
58. End Sub

½Æ»s¥N½X

¦^´_ 3# èªÎ¯Ì¦Ï

samwang

¦^´_ 10# èªÎ¯Ì¦Ï

§ó§ï¦p¤U¬õ¦r¡A½Ð¦A´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Dim PH$, FN$, Arr(1 To 65536, 1 To 3)

èªÎ¯Ì¦Ï

¦^´_ 9# samwang


¦]­ì©lÀɮ׬OÆZªøªº¡A¦AÀ°§Ú½T»{¬Ý¬Ý¡AÁÂÁÂ

samwang

¦^´_ 8# èªÎ¯Ì¦Ï

¥i¥H´£¨Ñ§Aªº¸ê®ÆÀÉ®×(¦³¥X²{°ÝÃD)¡A§Ú¨Ó´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

èªÎ¯Ì¦Ï

¦^´_ 7# samwang

·|¸õ¥X¦¹°ÝÃD~Àɮפw¦³«ö·Ó¹Ï¤ù1³£©ñ¦bfile¸Ì­±¡C

samwang

¦^´_ 6# èªÎ¯Ì¦Ï


©Ò¦³Àɮשñ¦bfileªº¸ê®Æ§¨¦pªþ¹Ï¡A½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub ¸ü¤J¤å¦rÀÉ()
Dim PH$, FN$, Arr(1 To 2000, 1 To 3), n&, fs, f, fc, T, j%
Application.ScreenUpdating = False: Application.DisplayAlerts = False
Set fs = CreateObject("Scripting.FileSystemObject")
If Len(Dir(ThisWorkbook.Path & "\TEST", vbDirectory)) = 0 Then
    MkDir ThisWorkbook.Path & "\TEST"
End If

PH = ThisWorkbook.Path & "\file\"
Do
    If FN = "" Then FN = Dir(PH & "*.txt") Else FN = Dir
    If FN = "" Then Exit Do
    Open PH & "\" & FN For Input As #1
    While Not EOF(1)
        Line Input #1, T
        n = n + 1
        If InStr(T, ",") < 1 Then
            Arr(n, 1) = T
        Else
            TR = Split(T, ",")
            For j = 0 To 2: Arr(n, j + 1) = TR(j): Next
        End If
    Wend
    Close #1
    FN1 = Split(FN, ".")(0)
   
    Set f = fs.GetFolder(PH): Set fc = f.Files
    For Each f1 In fc
        If UCase(Split(f1.Name, ".")(1)) = "CSV" Then
            If Split(f1.Name, ".")(0) = FN1 Then
                With Workbooks.Open(f1.Path)
                    With Sheets(1)
                        R = .Range("a65536").End(3).Row + 1
                        .Range("a" & R).Resize(n, 3) = Arr
                        '¥t¦sTESTÀÉ
                        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\TEST\" & FN1, _
                        FileFormat:=xlCSV, CreateBackup:=False
                        ActiveWindow.Close SaveChanges:=False
                    End With
                End With
            End If
        End If
    Next
    Erase Arr: n = 0
   
Loop
Set f = Nothing: Set fs = Nothing: Set fc = Nothing
Application.ScreenUpdating = True: Application.DisplayAlerts = True
End Sub

èªÎ¯Ì¦Ï

¦^´_ 5# samwang


«D±`©êºp...§Ú¤£¯à¤U¸üªþ¥ó¡AÅv­­¤£¨¬:'( :'(
¥icopy¤å¦rµ¹§Ú¬Ý¶Ü??ÁÂÁ©p~

samwang

¦^´_ 3# èªÎ¯Ì¦Ï


»Ý¨D¦pªþ¥ó¨º¼Ë¶Ü? ½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ