我写了一个宏来打开.csv,复制几个单元格,然后打开.txt并复制更多。
.csv的运行速度非常快,但它确实在.txt上停滞了,有时会崩溃。
我两次收到“正在等待另一个应用程序完成OLE操作”消息,并认为这可能是问题所在,但不知道如何解决该问题。
它确实可以工作,但是希望它运行得更快。
谢谢!
Option Explicit
Sub Import_Racecutter()
'
' Import_Racecutter Macro
'
Application.ScreenUpdating = False
Application.IgnoreRemoteRequests = True
Dim source As Variant
Dim ws As Worksheet
Dim tbl As ListObject
Dim newrow As ListRow
Dim pasteCell As Range
Set ws = ThisWorkbook.Sheets(1)
Set tbl = ws.ListObjects.item("Table2")
MsgBox "Select the RACECUTTER file to Import"
source = Application.GetOpenFilename(FileFilter:="CSV Files (.csv), *.csv", MultiSelect:=False)
If source = False Then
MsgBox "No file selected. Cannot continue."
Exit Sub
End If
Workbooks.Open (source)
'On Error GoTo exit
Set newrow = tbl.ListRows.Add 'Insert new row at the bottom of the table
'Racecutter Data Merge
ActiveSheet.Range("B3").Copy Destination:=newrow.Range(1, 5) 'TWS
ActiveSheet.Range("B4").Copy Destination:=newrow.Range(1, 6) 'TWA
ActiveSheet.Range("B6").Copy Destination:=newrow.Range(1, 7) 'AWS
ActiveSheet.Range("B7").Copy Destination:=newrow.Range(1, 8) 'AWA
ActiveSheet.Range("B5").Copy Destination:=newrow.Range(1, 9) 'BS
ActiveSheet.Range("B8").Copy Destination:=newrow.Range(1, 10) 'HEEL
ActiveSheet.Range("B12").Copy Destination:=newrow.Range(1, 11) 'HS Load
ActiveSheet.Range("B19").Copy Destination:=newrow.Range(1, 12) 'MS Load
ActiveSheet.Range("B10").Copy Destination:=newrow.Range(1, 13) 'Mast Rotation
ActiveSheet.Range("B11").Copy Destination:=newrow.Range(1, 14) 'Traveler Position
ActiveSheet.Range("B15").Copy Destination:=newrow.Range(1, 15) 'V1 Port
ActiveSheet.Range("B16").Copy Destination:=newrow.Range(1, 16) 'V1 Stbd
ActiveSheet.Range("B17").Copy Destination:=newrow.Range(1, 17) 'D1 Port
ActiveSheet.Range("B18").Copy Destination:=newrow.Range(1, 18) 'D1 Stbd
ActiveWorkbook.Close
'Application.CutCopyMode = False
'Open Vspars File
MsgBox "Now select the VSpars file matching the Racecutter file you just opened"
source = Application.GetOpenFilename(FileFilter:="TXT Files (.txt), *.txt", MultiSelect:=False)
Workbooks.OpenText source, DataType:=xlDelimited, Tab:=True
'VSpars Data Merge
'12.5%
ActiveSheet.Range("C8").Copy Destination:=newrow.Range(1, 19) 'Camber
ActiveSheet.Range("D8").Copy Destination:=newrow.Range(1, 20) 'Draft
ActiveSheet.Range("E8").Copy Destination:=newrow.Range(1, 21) 'Front %
ActiveSheet.Range("F8").Copy Destination:=newrow.Range(1, 22) 'Back %
ActiveSheet.Range("A8").Copy Destination:=newrow.Range(1, 23) 'Entry
ActiveSheet.Range("B8").Copy Destination:=newrow.Range(1, 24) 'Exit
ActiveSheet.Range("G8").Copy Destination:=newrow.Range(1, 25) 'Twist
'25%
ActiveSheet.Range("C7").Copy Destination:=newrow.Range(1, 26) 'Camber
ActiveSheet.Range("D7").Copy Destination:=newrow.Range(1, 27) 'Draft
ActiveSheet.Range("E7").Copy Destination:=newrow.Range(1, 28) 'Front %
ActiveSheet.Range("F7").Copy Destination:=newrow.Range(1, 29) 'Back %
ActiveSheet.Range("A7").Copy Destination:=newrow.Range(1, 30) 'Entry
ActiveSheet.Range("B7").Copy Destination:=newrow.Range(1, 31) 'Exit
ActiveSheet.Range("G7").Copy Destination:=newrow.Range(1, 32) 'Twist
'50%
ActiveSheet.Range("C6").Copy Destination:=newrow.Range(1, 33) 'Camber
ActiveSheet.Range("D6").Copy Destination:=newrow.Range(1, 34) 'Draft
ActiveSheet.Range("E6").Copy Destination:=newrow.Range(1, 35) 'Front %
ActiveSheet.Range("F6").Copy Destination:=newrow.Range(1, 36) 'Back %
ActiveSheet.Range("A6").Copy Destination:=newrow.Range(1, 37) 'Entry
ActiveSheet.Range("B6").Copy Destination:=newrow.Range(1, 38) 'Exit
ActiveSheet.Range("G6").Copy Destination:=newrow.Range(1, 39) 'Twist
'75%
ActiveSheet.Range("C5").Copy Destination:=newrow.Range(1, 40) 'Camber
ActiveSheet.Range("D5").Copy Destination:=newrow.Range(1, 41) 'Draft
ActiveSheet.Range("E5").Copy Destination:=newrow.Range(1, 42) 'Front %
ActiveSheet.Range("F5").Copy Destination:=newrow.Range(1, 43) 'Back %
ActiveSheet.Range("A5").Copy Destination:=newrow.Range(1, 44) 'Entry
ActiveSheet.Range("B5").Copy Destination:=newrow.Range(1, 45) 'Exit
ActiveSheet.Range("G5").Copy Destination:=newrow.Range(1, 46) 'Twist
'87.5%
ActiveSheet.Range("C4").Copy Destination:=newrow.Range(1, 47) 'Camber
ActiveSheet.Range("D4").Copy Destination:=newrow.Range(1, 48) 'Draft
ActiveSheet.Range("E4").Copy Destination:=newrow.Range(1, 49) 'Front %
ActiveSheet.Range("F4").Copy Destination:=newrow.Range(1, 50) 'Back %
ActiveSheet.Range("A4").Copy Destination:=newrow.Range(1, 51) 'Entry
ActiveSheet.Range("B4").Copy Destination:=newrow.Range(1, 52) 'Exit
ActiveSheet.Range("G4").Copy Destination:=newrow.Range(1, 53) 'Twist
ActiveWorkbook.Close
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.IgnoreRemoteRequests = False
'exit_:
'Application.ScreenUpdating = True
'If Err Then MsgBox Err.Description, vbCritical, "Error"
End Sub
答案 0 :(得分:1)
根据该网站,从非Excel文件读取数据时可能会发生错误:
https://www.thewindowsclub.com/excel-is-waiting-for-another-application
我的猜测是,与普通的excel或csv文件相比,文本文件的加载效率较低,并且每个复制操作都迫使Excel分析文本文件以确定应复制哪些数据。将所有必需的数据一次复制到临时工作表上的当前工作簿,然后将所需的值从那里复制到表中,也许会更快。
尝试在工作簿中添加一个名为“ Temp”的新工作表,然后您可以执行以下操作:
Dim wsTemp as Worksheet
Set wsTemp = ThisWorkbook.Sheets("Temp")
然后在打开文本文件后:
wsTemp.Range("A1:G8").Value = Activesheet.Range("A1:G8").Value
ThisWorkbook.Activate
wsTemp.Select
然后,其余代码应按原样工作。 (尽管使用对wsTemp的引用比先激活它更好。)
希望此文本文件中所有数据的单一复制操作与您当前代码中的单个复制操作大致相同。工作簿中工作表之间的副本应该更快。
答案 1 :(得分:0)
与其复制和粘贴(包括所有格式),不如直接通过赋值直接复制值:
代替:
ActiveSheet.Range("C8").Copy Destination:=newrow.Range(1, 19) 'Camber
使用:
newrow.Range(1, 19) = ActiveSheet.Range("C8")