大家好
我用以下的vba嘗試將excel資料依要求格式匯出文字檔

資料是會成功了 但是尾巴總是會多一列空白

請教高手 是哪裡有問題 感謝

Sub test1()

myDir = ThisWorkbook.Path '指定路徑為工作表所在目錄

ChDrive myDir

ChDir myDir

last_rows = Selection.SpecialCells(xlCellTypeLastCell).Row

MsgBox "最後一列 : " & last_rows

last_columns = Selection.SpecialCells(xlCellTypeLastCell).Column

MsgBox "最後一行 : " & last_columns

Set myRng = Range(Cells(10, 1), Cells(last_rows, last_columns)) '定義要抓取的範圍

check = myRng.Rows.Count

MsgBox "迴圈次數 : " & check

Dim Cell1 As String

Dim Cell2 As String

Dim padding3, padding4, padding5, padding6, padding7, padding8, padding9, padding10, padding11, padding12, padding13, padding14, padding15, padding16, padding17, padding18, padding19 As String

Dim filename As String '定義檔名為時間

a = Range("B2").Text

b = Range("B4").Text

c = Range("B3").Text

filename = a & b & c & ".txt" '利用儲存格產生檔名

Open filename For Output As #1

For i = 1 To myRng.Rows.Count

padding3 = myRng.Cells(i, 1).Text  

padding4 = myRng.Cells(i, 2).Value  

padding5 = myRng.Cells(i, 3).Value  

padding6 = myRng.Cells(i, 4).Value  

padding7 = myRng.Cells(i, 5).Value  

padding8 = myRng.Cells(i, 6).Value  

padding9 = myRng.Cells(i, 7).Value  

padding10 = myRng.Cells(i, 8).Value 

padding11 = myRng.Cells(i, 9).Value 

padding12 = myRng.Cells(i, 10).Value

padding13 = myRng.Cells(i, 11).Value

padding14 = myRng.Cells(i, 12).Value

padding15 = myRng.Cells(i, 13).Value

padding16 = myRng.Cells(i, 14).Value
    
padding17 = myRng.Cells(i, 15).Value

padding18 = myRng.Cells(i, 16).Value

padding19 = myRng.Cells(i, 17).Value

'依要求格式轉換
   
padding3 = RstrFix(padding3, 4)

padding4 = LstrFix(padding4, 16)

padding5 = LstrFix(padding5, 16)

padding6 = LstrFix(padding6, 16)

padding7 = LstrFix(padding7, 16)

padding8 = LstrFix(padding8, 16)

padding9 = LstrFix(padding9, 16)

padding10 = LstrFix(padding10, 16)

padding11 = LstrFix(padding11, 16)

padding12 = LstrFix(padding12, 16)

padding13 = LstrFix(padding13, 16)

padding14 = LstrFix(padding14, 16)

padding15 = LstrFix(padding15, 16)

padding16 = LstrFix(padding16, 16)

padding17 = LstrFix(padding17, 16)

padding18 = LstrFix(padding18, 16)

padding19 = LstrFix(padding19, 16)

Cell2 = c & b

Cell1 = Cell2 & padding3 & padding4 & padding5 & padding6 & padding7 & padding8 & padding9 & padding10 & padding11 & padding12 & padding13 & padding14 & padding15 & padding16 & padding17 & padding18 & padding19

Print #1, Cell1

Next

Close #1

MsgBox ("Successfull Filing for this Month !!!")

End Sub

Function LstrFix(myData, myLen) As String

Dim myPad As Integer, myText As String, myPN, newData

myPad = myLen - Len(myData)

For i = 1 To myPad

    myText = myText + "0"

Next

LstrFix = myText & myData

End Function

Function RstrFix(myData, myLen) As String

Dim myPad As Integer, myText As String, myPN, newData

myPad = myLen - Len(myData)

For i = 1 To myPad

    myText = myText + " "

Next

RstrFix = myData & myText

End Function