返回列表 上一主題 發帖

[發問] VBA程式 開啟一個相同檔名不同檔案

回復 1# 癡肥羔羊


看不太懂您的需求為何?可以上傳附件和需求結果,謝謝
將資料處理後另存一個新檔案>> 資料怎麼處理?

TOP

回復 3# 癡肥羔羊


需求如附件那樣嗎? 請測試看看,謝謝

TEST.zip (32.33 KB)

TOP

本帖最後由 samwang 於 2022-4-17 18:22 編輯

回復 6# 癡肥羔羊


所有檔案放在file的資料夾如附圖,請測試看看,謝謝
Sub 載入文字檔()
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
                        '另存TEST檔
                        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

1.JPG (17.71 KB)

1.JPG

完成後結果.JPG (52.41 KB)

完成後結果.JPG

TOP

回復 8# 癡肥羔羊

可以提供你的資料檔案(有出現問題),我來測試看看,謝謝

TOP

回復 10# 癡肥羔羊

更改如下紅字,請再測試看看,謝謝
Dim PH$, FN$, Arr(1 To 65536, 1 To 3)

TOP

        靜思自在 : 不怕事多,只怕多事。
返回列表 上一主題