Question

此处有新的VBA用户，感谢您的耐心等待。我想复制并粘贴从单个封闭工作表到活动工作表的范围值。具体来说，我想在活动工作簿中使用VBA从TOOL.XLSM中的“AllData”选项卡复制范围A1：HW6000，同时关闭TOOL.XLSM并粘贴到活动工作表中的活动工作簿中作为值的活动工作表中的HW6000 。

我有代码可以执行此操作（在stackoverflow处理Peh，谢谢Peh！），但代码永远运行（超过45分钟），因为运行代码似乎重新计算新工作簿和导入工作簿同时，导入工作簿（TEST.xslm）非常大。我在Mac上运行。这是我目前的代码：

Sub ImportData()
Dim App As New Excel.Application 'create a new (hidden) Excel

' remember active sheet
Dim wsActive As Worksheet
Set wsActive = ThisWorkbook.ActiveSheet

' open the import workbook in new Excel (as read only)
Dim wbImport As Workbook
Set wbImport = App.Workbooks.Open(Filename:="/Users/cwight/Desktop/TOOL.xlsm", UpdateLinks:=True, ReadOnly:=True)

'copy the data of the import sheet
wbImport.Worksheets("AllDATA").Range("A1:HW6000").Copy
wsActive.Range("A1").PasteSpecial Paste:=xlPasteFormats 'paste formats
wsActive.Range("A1").PasteSpecial Paste:=xlPasteValues  'paste values

App.CutCopyMode = False 'clear clipboard (prevents asking when wb is closed)
wbImport.Close SaveChanges:=False 'close wb without saving
App.Quit 'quit the hidden Excel
End Sub

我可以在导入过程中集成以下代码来关闭计算吗？如果是这样，怎么样？我无法弄清楚：

 Application.Calculation = xlCalculationManual
 Application.ScreenUpdating = False
 Application.DisplayStatusBar = False

还有什么我可以做的吗？非常感谢你的时间。

Answer 1

这里是一个使用矢量从一个excel到另一个excel的复制数据的函数，确保将其分配给一个按钮并指定一个单元格以指定路径。创建一个名为“FUNCTIONS”的模块并将其粘贴到那里：

Function range_to_variant(variant_arr As Variant, sheet As Worksheet, first_range As String, last_column As String, last_row_column As String)
variant_arr = sheet.Range(first_range & ":" & last_column & sheet.Cells(sheet.Rows.Count, last_row_column).End(xlUp).Row).Value
End Function

Function array_to_range(variant_arr As Variant, sheet As Worksheet, first_range As String)
'example
'    Call array_to_range(new_variant, Worksheets("Sheet1"), "1.1")
Dim split_arr() As String
split_arr = Split(first_range, ".")
Dim range1 As String
Dim range2 As String
Dim range3 As String
Dim range4 As String
range1 = Replace(sheet.Cells(CInt(split_arr(0)), CInt(split_arr(1))).Address, "$", "")
range2 = Replace(sheet.Cells(CInt(split_arr(0)) + UBound(variant_arr, 1) - 1, CInt(split_arr(1)) + UBound(variant_arr, 2) - 1).Address, "$", "")
sheet.Range(range1 & ":" & range2).Value = variant_arr
sheet.Range(range1 & ":" & range2).Columns.AutoFit
End Function

完成后，创建2 sub，其中写下：

Sub select_fle2()
Call Select_file("b10", "xlsm")
End Sub

Sub Run()
Dim xl As New Excel.Application
xl.Workbooks.Open (Worksheets("MAIN").Range("B7").Value)
xl.Visible = False
Dim raw_data As Variant
Call range_to_variant(raw_data, xl.Worksheets("your_sheet_name"), "A1", "HW", "A")
xl.Quit
Set xl = Nothing
ThisWorkbook.Worksheets("sheet_paste").Columns("A:HW").ClearContents
Call array_to_range(raw_data, Worksheets("sheet_paste"), "1.1")
End sub

将大型实时工作表从已关闭的工作簿复制到活动工作簿，停止计算，Excel VBA，Mac OSX

1 个答案: