如果您有任何問題,這個版本顯示瞭如何確定最後的行和列
Option Explicit
Public Sub RangeToFile()
Dim ws As Worksheet, lr As Long, lc As Long, r As Long, c As Long
Dim arr As Variant, fName As String, fNumber As Long, txtLine As String
fName = ThisWorkbook.Path & "\Output.txt" 'File name & path based on workbook path
Set ws = Sheet1 'set a reference to main sheet
lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'find last row in column A
lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column 'find last column in row 1
arr = ws.Range(ws.Cells(1, "A"), ws.Cells(lr, lc)) 'Copy range to array
fNumber = FreeFile 'get next available file number assigned by windows
Open fName For Output As #fNumber 'create a new file, or overwrite an existing one
For r = 1 To UBound(arr, 1) '1st array dimension is rows
For c = 1 To UBound(arr, 2) '2nd array dimension is columns
txtLine = txtLine & arr(r, c) & ", " 'concatenate each cell in row, on a line
Next c 'the end of the row, moving to next one
txtLine = Left(txtLine, Len(txtLine) - 2) 'remove the extra comma at end of line
txtLine = txtLine & vbCrLf 'append a carriage return to the line
Next r
txtLine = Left(txtLine, Len(txtLine) - 2) 'remove carriage return at end of line
Print #fNumber, txtLine 'print entire text to the file with an extra carriage return
Close #fNumber 'close the text file
End Sub
而這一次調換列行:
Public Sub RangeToFileColumnsToRows()
Dim ws As Worksheet, lr As Long, lc As Long, r As Long, c As Long
Dim arr As Variant, fName As String, fNumber As Long, txtLine As String
fName = ThisWorkbook.Path & "\Output.txt" 'File name & path based on workbook path
Set ws = Sheet1 'set a reference to main sheet
lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'find last row in column A
lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column 'find last column in row 1
arr = ws.Range(ws.Cells(1, "A"), ws.Cells(lr, lc)) 'Copy range to array
fNumber = FreeFile 'get next available file number assigned by windows
Open fName For Output As #fNumber 'create a new file, or overwrite an existing one
For c = 1 To UBound(arr, 2) '2nd array dimension is columns
For r = 1 To UBound(arr, 1) '1st array dimension is rows
txtLine = txtLine & arr(r, c) & ", " 'concatenate each cell in col, on a line
Next r 'the end of the col, moving to next one
txtLine = Left(txtLine, Len(txtLine) - 2) 'remove the extra comma at end of line
txtLine = txtLine & vbCrLf 'append a carriage return to the line
Next c
txtLine = Left(txtLine, Len(txtLine) - 2) 'remove carriage return at end of line
Print #fNumber, txtLine 'print entire text to the file
Close #fNumber 'close the text file
End Sub