我正在編寫一個代碼,以便從主電子表格中複製和重新排列所需的數據列,並將其保存爲文本文件。 我的代碼的作用如下: 1)要求用戶定位主電子表格 2)將所需數據列複製並重新排列到包含宏的工作電子表格中3)要求用戶鍵入文本的名稱文件 4)打印從工作的電子表格中的數據,而無需執行問題文本文件Excel VBA:將數據從電子表格打印到文本文件需要很長時間
Sub import()
Dim ws As Worksheet
Dim bl As Worksheet
Dim i As Long, lastrow As Long
Dim dataArr As Variant
Dim fpath As String
Dim txtfile As String
Dim baseline As Workbook
'Opens file dialog to ask user to select baseline file
MsgBox ("Please select baseline file for output.")
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select Baseline File"
.AllowMultiSelect = False
If .Show = -1 Then
fpath = .SelectedItems(1)
Else
On Error Resume Next
MsgBox ("No file selected. Stopping macro")
Exit Sub
End If
End With
Set baseline = Workbooks.Open(fpath)
Set ws = ThisWorkbook.Sheets(2)
Set bl = baseline.Sheets(1)
lastrow = bl.Cells(Rows.Count, "A").End(xlUp).Row
ws.UsedRange.Offset(1).Clear
'This block of code copies data columns from baseline file to working spreadsheet
ws.Range("AG2:AG" & lastrow) = bl.Range("F2:F" & lastrow)
ws.Range("AH2:AH" & lastrow) = bl.Range("G2:G" & lastrow)
ws.Range("AB2:AB" & lastrow) = bl.Range("N2:N" & lastrow)
ws.Range("AC2:AC" & lastrow) = bl.Range("R2:R" & lastrow)
ws.Range("BF2:BF" & lastrow) = bl.Range("S2:S" & lastrow)
ws.Range("AA2:AA" & lastrow) = bl.Range("U2:U" & lastrow)
ws.Range("BA2:BA" & lastrow) = bl.Range("X2:X" & lastrow)
ws.Range("BQ2:BQ" & lastrow) = bl.Range("AA2:AA" & lastrow)
ws.Range("B2:B" & lastrow) = bl.Range("AB2:AB" & lastrow)
ws.Range("A2:A" & lastrow) = bl.Range("AD2:AD" & lastrow)
ws.Range("BW2:BW" & lastrow) = bl.Range("AK2:AK" & lastrow)
ws.Range("BH2:BH" & lastrow) = bl.Range("AL2:AL" & lastrow)
ws.Range("BR2:BR" & lastrow) = bl.Range("AM2:AM" & lastrow)
ws.Range("AL2:AL" & lastrow) = bl.Range("AP2:AP" & lastrow)
ws.Range("AP2:AP" & lastrow) = bl.Range("BA2:BA" & lastrow)
ws.Range("AQ2:AQ" & lastrow) = bl.Range("BB2:BB" & lastrow)
ws.Range("AU2:AU" & lastrow) = bl.Range("BC2:BC" & lastrow)
ws.Range("AO2:AO" & lastrow) = bl.Range("BK2:BK" & lastrow)
ws.Range("AT2:AT" & lastrow) = bl.Range("BO2:BO" & lastrow)
txtfile = InputBox("Type in name of audience file for output")
Do While txtfile = vbNullString
MsgBox ("Name of output audience file is not entered. Please try again.")
txtfile = InputBox("Type in name of audience file for output")
Loop
'Write values from copied spreadsheet to text file
dataArr = ws.UsedRange.Value
With CreateObject("Scripting.FileSystemObject").CreateTextFile(ThisWorkbook.path & "\" & txtfile & ".txt")
For i = 1 To UBound(dataArr, 1)
.writeline Join(Application.Index(dataArr, i, 0), vbTab)
Next i
.Close
End With
MsgBox ("Macro completed execution. File saved as " & txtfile & ".txt")
End Sub
2)當我第一編碼它。當我今天再次運行它時,2)不會執行,並且文本文件輸出爲空。主電子表格包含> 30000行數據。
此外,是否可以複製和重新排列主電子表格並將其直接打印到文本文件?
編輯 行,所以我改變了複製和粘貼和它的作品。我現在的下一個問題是將數據打印到文本文件。使用當前的代碼將電子表格中的數據打印到文本文件需要很長時間。有沒有一種有效的打印方式?
請把你的時間反饋給你以前的問題。謝謝 – user3598756