返回列表 上一主題 發帖

[發問] 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

回復 8# n7822123

恩....21個空白字元,寫成20個了,這裡改一下

Arr(R, 1) = Arr(R, 1) & String(21, " ")
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 10# dou10801

感謝 n7822123 提供另一種思路,重複存檔時,系統會詢問,[是否要取代],如按[否]會中斷,如何解決,感恩.

那就強制覆蓋,不詢問就好了,添加一行程式即可

Sub Test1130()
Dim Arr, R&, C&
Application.DisplayAlerts = False   '若已有檔案、直接覆蓋不詢問
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(21, " ")
  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

本帖最後由 n7822123 於 2020-12-5 03:00 編輯

回復 12# dou10801


因為你的xlsx檔,本身就有標題列阿=.=

Arr 陣列一開始就會取到標題列,所以你的For迴圈,R改成從2開始也沒有用

最後把陣列的值貼回去儲存格還是有標題列~~

只要加1行程式刪掉第一列就好了



      MES = UBound(Arr) - 1
      .[A1].Resize(UBound(Arr), UBound(Arr, 2)) = Arr
      .Columns("B").Resize(, UBound(Arr, 2)).Delete
      .Rows(1).Delete
      .SaveAs txtPath, 42
      .Parent.Close True
    End With
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

本帖最後由 n7822123 於 2020-12-5 14:15 編輯

回復 14# quickfixer


後來給的檔案和一開始的範本,根本不一樣

沒錯!!!

多了標題列,金額那欄字數不固定,那個要加21個空白的條件,是錯的吧?
空白字數是其實變動的才對?還是金額那欄要補字數?   

這個我沒仔細看他後面的範本和他補的程式,看他需要什麼再去確認就好

我們可以靜觀其變
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

        靜思自在 : 不要隨心所欲,要隨心教育自己。
返回列表 上一主題