【VBA】將Excel數據轉化為txt文本數據

目錄

• 1.需求描述
• 2.實現代碼
• 3.操作步驟

1.需求描述

在data目下有以下兩個數據文件：

其數據內容如下：

現在需要將數據轉化為txt文本類型，最終效果如下：

2.實現代碼

Sub magic()
Dim mypath$, okpath$, f$, num%, fn$, arr, i%, j%, wb As Workbook, myarea As Range, istr$
Dim fd As FileDialog
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
    .Title = "請選擇待處理文件所在文件夾："
    If .Show <> -1 Then Exit Sub
    mypath = .SelectedItems(1)
End With
okpath = mypath & "\處理后" & Format(Now, "yyyymmddhhmmss") & "\"
MkDir okpath
fn = Dir(mypath & "\*.xl*")
Do While fn <> ""
    Set wb = GetObject(mypath & "\" & fn)
    num = num + 1
    arr = wb.Sheets(1).Range("a1").CurrentRegion
    If VBA.IsArray(arr) Then
        f = okpath & Split(fn, ".xl")(0) & ".txt"
        Open f For Output As #1
        For i = 1 To UBound(arr)
            istr = ""
            For j = 1 To UBound(arr, 2)
                If arr(i, j) <> "" And j = 2 Then
                    arr(i, j) = CStr(arr(i, j))
                Else
                    arr(i, j) = CStr(arr(i, j)) & ","
                End If
                istr = istr & CStr(arr(i, j))
                
            Next
            If istr <> "" Then
                Print #1, istr
            End If
        Next
        Close #1
    End If
    wb.Close False
    fn = Dir()
Loop
MsgBox "處理完成" & num & "個文件!"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

3.操作步驟

點擊下載附件
解壓后，打開文件Excel文件轉化為txt.xlsm，然后點擊按鈕運行，打開窗口后，選擇需要轉換文件所在的目錄，如下圖：

確定后即可開始轉換，轉換后得到的文件在data目錄下。