【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目录下。