2017-01-31 39 views
0

我正在編寫一個代碼,以便從主電子表格中複製和重新排列所需的數據列,並將其保存爲文本文件。 我的代碼的作用如下: 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行數據。

此外,是否可以複製和重新排列主電子表格並將其直接打印到文本文件?


編輯 行,所以我改變了複製和粘貼和它的作品。我現在的下一個問題是將數據打印到文本文件。使用當前的代碼將電子表格中的數據打印到文本文件需要很長時間。有沒有一種有效的打印方式?

+0

請把你的時間反饋給你以前的問題。謝謝 – user3598756

回答

0

而不是

ws.Range("AG2:AG" & lastrow) = bl.Range("F2:F" & lastrow)嘗試

bl.Range("F2:F" & lastrow).Copy Destination:=ws.Range("AG2:AG" & lastrow)

它應該工作

+0

試過了,它的工作原理!謝謝。 – peejayjay

相關問題