Question

我正在编写代码以从主电子表格中复制和重新排列所需的数据列，并将其另存为文本文件。我的代码的作用如下： 1）要求用户找到主电子表格 2）将所需数据列复制并重新排列到包含宏的工作电子表格 3）要求用户输入文本文件的名称 4）将工作电子表格中的数据打印到文本文件

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行数据。

此外，是否可以复制和重新排列主电子表格并将其直接打印到文本文件中？

修改好的，所以我改变了副本和粘贴，它的工作原理。我现在的下一个问题是将数据打印到文本文件。使用我当前的代码将数据从电子表格打印到文本文件需要很长时间。有没有一种有效的打印方式？

Answer 1

而不是

ws.Range("AG2:AG" & lastrow) = bl.Range("F2:F" & lastrow)尝试

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

它应该有用

Excel VBA：将电子表格中的数据打印到文本文件需要太长时间

1 个答案: