iT邦幫忙

0

為何excel vba 匯出文字檔多一行空白

大家好
我用以下的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

1 個回答

1
paicheng0111
iT邦高手 1 級 ‧ 2020-04-09 18:39:30
最佳解答

多一列空白是因為Print敘述會自帶換行符號。

如果你希望最後一行不要加上換行符號的話,請將

Print #1, Cell1

取代為

If i < myRng.Rows.Count Then
    Print #1, Cell1
Else
    Print #1, Cell1;
End If

第一次看到這個問題
第一次看到這個答案
按三個
/images/emoticon/emoticon12.gif/images/emoticon/emoticon12.gif/images/emoticon/emoticon12.gif

我要發表回答

立即登入回答