怎样用VBA把EXCEL数据按TXT的格式导出来？

想飞的鱼888

怎样用VBA把EXCEL数据按TXT的格式导出来？固定是100行数据

小凡、、、

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, i&, j&, strJoin$
   
    ar = [A1].CurrentRegion.Value
    For i = 1 To UBound(ar)
        For j = 1 To UBound(ar, 2)
            strJoin = strJoin & vbCrLf & ar(i, j)
        Next j
    Next i
    Open ThisWorkbook.Path & "\test.txt" For Output As #1
        Print #1, Mid(strJoin, 3)
    Close #1

    Beep
End Sub

gwjkkkkk

请参考。。。

gwjkkkkk

。。。。。。。。。。。。。

quqiyuan

参与一下，仅供参考。。。

ykcbf1100

参与一下。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.8.19
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     r = Cells(Rows.Count, 1).End(3).Row
   
5.     arr = [a1].Resize(r, 5)
   
6.     p = ThisWorkbook.Path & ""
   
7.     ReDim brr(1 To 1000, 1 To 1)
   
8.     For i = 1 To UBound(arr)
   
9.         For j = 1 To UBound(arr, 2)
   
10.             m = m + 1
    
11.             brr(m, 1) = arr(i, j)
    
12.         Next
    
13.     Next
    
14.     Set wb = Workbooks.Add
    
15.     wb.Sheets(1).[a1].Resize(m, 1) = brr
    
16.     wb.SaveAs Filename:=p & "test.txt", FileFormat:=xlText
    
17.     wb.Close
    
18.     Application.ScreenUpdating = True
    
19.     MsgBox "OK！"
    
20. End Sub
    
21. 
    

复制代码

quqiyuan

代码如下。。。
Sub test()
    Set wb = ThisWorkbook
    Set sht = wb.Sheets("sheet1")
    p = wb.Path & "\"
    f = p & Split(wb.Name, ".xls")(0) & ".txt"
    arr = sht.UsedRange
    If Dir(f) <> "" Then Kill f
    Open f For Output As #1
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            s = s & arr(i, j) & vbCrLf
        Next
    Next
    Print #1, s
    Close #1
    Beep
End Sub

想飞的鱼888

非常感谢楼上各位！