GetValue + 循环 = 可以更快吗？

Question

我创建了从其他（已关闭）excel 文件导入数据的主文件。我需要从中导入数据的文件有十个。我在 UserForm 中编写了一个代码，以便我的老板可以选择在哪里导入（工作表=wariant）文件。它没有完成，因为我需要添加选项按钮（用于选择要导入的文件），但主要核心如下所示。

但是有一个问题，在我们公司，我们有一台中型笔记本电脑，因此每个文件（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

Answer 1

您的 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

Answer 2

如果您打开每个工作簿而不是从已关闭的工作簿中逐个单元格地阅读，它可能会运行得更快。

Answer 3

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

GetValue = ExecuteExcel4Macro(arg)

Answer 4

要在不打开工作簿的情况下执行此操作，您可以将此代码粘贴到新模块中：

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

然后您可以像这样在一次调用中从关闭的工作簿中检索所有值：

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