Question

我创建了主文件，用于从其他（已关闭）excel文件导入数据。我需要从中导入数据的x-10个文件。我在UserForm中创建了一个代码，以便我的老板可以选择导入的位置（sheet = wariant）文件。它没有完成，因为我需要添加选项按钮（用于选择要导入的文件），但主核心看起来就像在下面。

但是有一个问题，在我们公司我们有一台中型笔记本电脑，所以代码（下面）在5-7分钟内执行每个文件（wariant）。我需要它尽可能快地运行。你能用它做点什么吗？

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

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

Answer 2

您的ExecuteExcel4Macro调用可能会减慢进程，因为它会打开相同的工作簿12,445次。你正在处理两个2-D阵列;一个在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 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")

GetValue + loop =可以更快吗？

4 个答案: