GetValue + loop =可以更快吗?

我已经创build了从其他(closures)excel文件导入数据的主文件。 有十个文件,我需要从中导入数据。 我在UserForm中创build了一个代码,这样我的老板可以select在哪里导入(sheet = wariant)文件。 它没有完成,因为我需要添加选项button(用于select要导入的文件),但主核心将看起来像下面。

但是有一个问题,在我们公司我们有一个中等级别的笔记本电脑,所以在每个文件(wariant)5-7分钟执行的代码(在下面)。 我需要它尽可能快地运行。 你能用它做点什么吗?

Private Sub CommandButton1_Click() StartTime = Timer Dim p As String Dim f As String Dim s As String Dim a As String Dim r As Long Dim c As Long Dim Warinat As String If UserForm1.War1 = True Then Wariant = "Wariant 1" If UserForm1.War2 = True Then Wariant = "Wariant 2" If UserForm1.War3 = True Then Wariant = "Wariant 3" If UserForm1.War4 = True Then Wariant = "Wariant 4" p = ThisWorkbook.path f = "files.xlsx" s = "Sheet1" Application.ScreenUpdating = False For r = 7 To 137 For c = 2 To 96 a = Cells(r, c).Address If IsNumeric(Cells(r, c)) = True And ThisWorkbook.Sheets(Wariant).Cells(r, c) <> "" _ Then ThisWorkbook.Sheets(Wariant).Cells(r, c) = _ ThisWorkbook.Sheets(Wariant).Cells(r, c).Value + GetValue(p, f, s, a) Else ThisWorkbook.Sheets(Wariant).Cells(r, c) = GetValue(p, f, s, a) End If Next c Next r EndTime = Timer MsgBox Format(EndTime - StartTime, ssss) Unload Me End Sub Private Function GetValue(path, file, sheet, ref) Dim arg As String If Right(path, 1) <> "\" Then path = path & "\" If Dir(path & file) = "" Then GetValue = "Files is missing" Exit Function End If arg = "'" & path & "[" & file & "]" & sheet & "'!" & _ Range(ref).Range("A1").Address(, , xlR1C1) GetValue = ExecuteExcel4Macro(arg) End Function Private Sub CommandButton2_Click() Unload Me End Sub Private Sub UserForm_Click() End Sub 

ExecuteExcel4Macro调用可能会减慢进程,因为它会打开相同的工作簿12,445次。 你正在处理两个二维数组; 一个在你的Wariant表单中,另一个在你导入的工作簿中。 尝试这样的事情。

 Dim var1 As Variant Dim var2 As Variant Dim wbImport As Workbook 'Set var1 as your range value var1 = ThisWorkbook.Sheets(Wariant).Range("B7:CR137").Value 'Open the Import workbook, set the value, then close it. Set wbImport = Application.Workbooks.Open(p & f) var2 = wbImport.Sheets("Sheet1").Range("B7:CR137").Value wbImport.Close 'Now loop through the variant arrays - much faster For r = 1 To 131 For c = 1 To 95 If IsNumeric(var1(r, c)) And var1(r, c) <> "" Then var1(r, c) = _ var1(r, c) + var2(r, c) Else var1(r, c) = var2(r, c) End If Next c Next r 'Finally, copy the variant array back into the workbook. ThisWorkbook.Sheets(Wariant).Range("B7:CR137").Value = var1 

如果打开每个工作簿,而不是从已closures的工作簿读取单元格,则运行速度可能会更快。

不是不知道你在用ExecuteExcel4Macro函数调用什么,因为调用macros可以是任何东西,很可能是你的代码缓慢执行的原因

 GetValue = ExecuteExcel4Macro(arg) 

要做到这一点而不打开工作簿,你可以将这段代码粘贴到一个新的模块中:

 Dim v As Variant Function GetValues(p As String, f As String, s As String, a As String) v = Empty Application.ExecuteExcel4Macro "'" & ThisWorkbook.Name & "'!SetV('" & p & "\[" & f & "]" & s & "'!" & a & ")" GetValues = v End Function Public Function SetV(Value) v = Value End Function 

然后,您可以通过一次调用来从closures的工作簿中检索所有值,如下所示:

 GetValues(ThisWorkbook.path,"files.xlsx","Sheet1","r7c2:r137c96")