返回列表 上一主題 發帖

[發問] EXCEL VBA XLSX TO TXT 空白行

本帖最後由 n7822123 於 2020-11-28 18:20 編輯

回復 7# dou10801

上面兩位大大提供的程式 都需要寫在你的 "A001.xlsx" 檔案中,

考量到你可能有多個檔案 Ex A002,A003 可能都需要轉成txt,

每個檔案都要複製那段程式,會有點煩瑣

我提供一段程式,讓你自己設定來源路徑&檔名(xlsx) & 輸出路徑&檔名(txt),會比較彈性

若要一次執行多個檔案,你可以自己改成迴圈

上面兩位大大都用 Open語法 做出純文字文件,我就換個寫法吧!

用Excel打開檔案(唯獨),再另存成txt檔

這段程式不限制你要放在哪個Excel檔,輸入輸出(I/O)設定好即可

程式如下


Sub Test1128()
Dim Arr, R&, C&
myPath$ = ThisWorkbook.Path & "\"
xlsPath$ = myPath & "A001.xlsx"   'xls檔案來源路徑,請自行設定(預設本程式檔案路徑下)
txtPath$ = myPath & "A001.txt"     '輸出txt的路徑&檔名,請自行設定(預設本程式檔案路徑下)
With Workbooks.Open(xlsPath, , True).Sheets(1)
  Arr = .[A1].CurrentRegion
  For R = 1 To UBound(Arr)
    For C = 2 To UBound(Arr, 2)
      Arr(R, 1) = Arr(R, 1) & Arr(R, C)
    Next C
    Arr(R, 1) = Arr(R, 1) & String(20, " ")
  Next R
  .[A1].Resize(UBound(Arr), UBound(Arr, 2)) = Arr
  .Columns("B").Resize(, UBound(Arr, 2)).Delete
  .SaveAs txtPath, 42
  .Parent.Close True
End With
End Sub
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

感謝兩位前輩指導,收下範本學習.
杜小平

TOP

回復 5# Joforn 可以了,感恩.
杜小平

TOP

回復 3# dou10801
將With Sheet1改成With ActiveSheet試試
世界那麼大,可我想去哪?

TOP

Sub test002()
    Open ThisWorkbook.Path & "\" & Split(ThisWorkbook.Name, ".")(0) & ".txt" For Output As #1
    For i = 1 To Range("a1").CurrentRegion.Rows.Count
        Print #1, Cells(i, 1) & Cells(i, 2) & Cells(i, 3) & Cells(i, 4) & Cells(i, 5) & Cells(i, 6) & Cells(i, 7) & Cells(i, 8) & String(21, " ")
    Next i
    Close #1
End Sub

TOP

RE: EXCEL VBA XLSX TO TXT 空白行

感謝...約福恩大大指點,執行後出現,此處需要物件.

此處需要物件.jpg (82.9 KB)

此處需要物件.jpg

此處需要物件.jpg (82.9 KB)

此處需要物件.jpg

杜小平

TOP

  1. Sub Test001()
  2.   Dim FileName  As String
  3.   Dim hFile     As Long
  4.   Dim lngEndRow As Long
  5.   Dim R As Long, C As Long
  6.   Dim bytText() As Byte
  7.   Dim strText   As String
  8.   Dim strCrLf   As String
  9.   
  10.   R = InStrRev(ThisWorkbook.Name, ".")
  11.   If R > 0 Then
  12.     FileName = Left$(ThisWorkbook.Name, R - 1)
  13.   Else
  14.     FileName = ThisWorkbook.Name
  15.   End If
  16.   strCrLf = Space(21) & vbCrLf
  17.   With Sheet1
  18.     lngEndRow = .Range("A" & .Rows.Count).End(xlUp).Row
  19.     hFile = FreeFile
  20.     Open ThisWorkbook.Path & Application.PathSeparator & FileName & ".TXT" For Binary As hFile
  21.     For R = 1 To lngEndRow
  22.       strText = vbNullString
  23.       For C = 1 To .UsedRange.Columns.Count
  24.         strText = strText & .Cells(R, C).Text
  25.       Next C
  26.       strText = strText & IIf(Len(strText), strCrLf, vbCrLf)
  27.       bytText() = StrConv(strText, vbFromUnicode)
  28.       Put hFile, , bytText()
  29.     Next R
  30.     Close hFile
  31.   End With
  32. End Sub
複製代碼
世界那麼大,可我想去哪?

TOP

        靜思自在 : 時時好心就是時時好日。
返回列表 上一主題