Excel VLOOKUP使用字符串在文件中查找数据。太慢了

这是我能得到的最好的了。以防任何人搜索并需要此类型数据的最佳答案。我不得不把它分成几个部分；这些工作计算机无法处理这种负载。最大数据拉动约为800行，拉动所有公式和数据大约需要一分钟。感谢下面的人和他们的帮助

Sub Update()

Dim ScreenUpdateState As Boolean
Dim StatusBarShow As Boolean
Dim CalcState As Long
Dim EventState As Boolean

Dim ws As Worksheet
Dim location_string As String
Dim count As Integer

'Save the current state of Excel settings
ScreenUpdateState = Application.ScreenUpdating
StatusBarShow = Application.DisplayStatusBar
CalcState = Application.Calculation
EventState = Application.EnableEvents

'Change Excel to faster procedure settings
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False


Set ws = ThisWorkbook.Sheets("%")
location_string = Sheets("Driver(s)").Cells(5, "G").Text

For count = 7 To 139
Cells(count, "F").Formula = "=IFERROR((VLOOKUP($C" & count    & ",'S:\xxxx\xxxxx\xxxxxx\xxxxx\xxxxxxxxxx\[xxxxxxxxxxxxxxxxxxxxxxxxxx.xlsx]" + location_string + "'!$A:$K,11,FALSE)),"" - "")"
Next count

'Restore Excel settings to original state
Application.ScreenUpdating = ScreenUpdateState
Application.DisplayStatusBar = StatusBarShow
Application.Calculation = CalcState
Application.EnableEvents = EventState

MsgBox ("Update Complete")
End Sub

祝你好运

• 罗斯

原始线程：

好的，我现在有了这个，它可以工作了。然而，它是缓慢地被用作 这一代码只运行所需计算的1/16，并且 需要几分钟才能完成。有人知道如何加快速度吗 过程

Sub Test()
Dim ws As Worksheet
Dim location_string As String
Dim count As Integer

Set ws = ThisWorkbook.Sheets("%")
location_string = ws.Cells(2, "E").Text

count = 7

While count < 138
Cells(count, "F").Formula = "=IFERROR((VLOOKUP($C" & count & ",
'S:\xxxx\xxxx\xxxx\xxxx\xxxxx\[xxxxxx.xlsx]" + location_string + "'!$A:$K,11,FALSE)),"" - "")"
count = count + 1
Wend

MsgBox ("Done")
End Sub

这会将单元格设置为='O614Epic

现在尝试添加一个Vlookup以从中提取：

S:\xxxxxxxxxxxxxxx\xxxxxxxxx\xx\xx\xx\[Random File Name.xlsx]0614Epic'!$A:$K

根据下拉框，######Epic文件将更改为 此时将值正确设置为字符串，但无法将Vlookup设置为 从正确的工作簿中提取。我也需要这个来打开非打开的 工作手册。数据太多，无法导入Excel工作簿本身

谢谢

• 罗斯

---

如果无法使用VLOOKUP，请跳到奖金信息。您可以使用VBA查找并将值放入单元格而不是公式，而不是让VLOOKUP公式在每次更改时重新计算并减慢电子表格的速度。我尽了最大努力使它符合你提供的条件。如果您对任何部分有疑问，请告诉我

Function WorksheetExists(ByVal WorksheetName As String) As Boolean
    Dim Sht As Worksheet

For Each Sht In ActiveWorkbook.Worksheets
    If Application.Proper(Sht.Name) = Application.Proper(WorksheetName) Then
        WorksheetExists = True
        Exit Function
    End If
Next Sht

End Function

Sub RossQuestion()
    Dim wbdata As Workbook
    Dim ws As Worksheet
    Dim Cell As Range
    Dim location_string As String
    Dim strcheck As String
    Dim count As Integer

Set ws = ThisWorkbook.Sheets("%")
location_string = ws.Cells(2, "E").Text
count = 7

While count < 138
    Set wbdata = Workbooks.Open("S:\xxxx\xxxx\xxxx\xxxx\xxxxx\xxxxxx.xlsx", , True)
    If WorksheetExists(location_string) Then
        Set Cell = wbdata.Sheets(location_string).Columns("A").Find(ws.Range("$C$" & count).Value, _
        wbdata.Sheets(location_string).Range("A1"), xlFormulas, xlWhole, xlByRows, xlNext, False)
        strcheck = Cell.Offset(0, 10).Value
        If Len(Trim(strcheck)) <> 0 Then
            ws.Cells(count, "F").Value = Cell.Offset(0, 10).Value
        Else
            ws.Cells(count, "F").Value = " - "
        End If
    Else
        ws.Cells(count, "F").Value = " - "
    End If
    count = count + 1
    wbdata.Close False
Wend

MsgBox "Done"

End Sub

它不接受表数组中的任何计算或连接，例如

=VLOOKUP('Driver(s)'!$G$3, 'S:\xxxxx\ & O614Epic & .xlsx'!$A:$K, 3, FALSE)
=VLOOKUP('Driver(s)'!$G$3, 'S:\xxxxx\ & INDIRECT(B1) & Epic.xlsx'!$A:$K, 3, FALSE)

除了完整路径字符串之外的任何内容都被视为太不稳定。匹配索引也是如此。不幸的是，VLOOKUP并不像您希望的那样动态，而且##########Epic需要由您输入O614Epic，而不是来自其他单元格

---

总有VBA。使用VBA，一切皆有可能。

删除循环并尝试以下操作：

Sub Test()
    Dim ws As Worksheet
    Dim location_string As String
    Dim myformula As String

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    Set ws = ThisWorkbook.Sheets("%")
    location_string = ws.Cells(2, "E").Value '~~> I'd suggest you use Value

    myformula = "=IFERROR((VLOOKUP($C7,'S:\xxxx\xxxx\xxxx\xxxx\xxxxx\[xxxxxx.xlsx]" & _
        location_string & "'!$A:$K,11,FALSE)),"" - "")"

    Range("F7:F138").Formula = myformula
    Msgbox "Done"

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub

---

这在我的机器中需要5秒，但如果目标文件位于网络服务器中，则会特别不同。HTH.

添加了一些VBA，它可以正常工作。太慢了。思想？谢谢你的建议。谢谢，我将使用加速部分。至于其他代码，每次拉取都会打开文件，这会使情况变得更糟。不幸的是，我想我必须把这个大文件分成更小的部分，然后再试试。感谢您的帮助。在范围上获取错误。Forumla=myformula行。威尔·特威克（Will tweek）过一会儿再来看看我能想出什么。谢谢你的帮助。

=VLOOKUP('Driver(s)'!$G$3, 'S:\xxxxx\FileName.xlsx'!$A:$K, 3, FALSE)

=VLOOKUP('Driver(s)'!$G$3, 'S:\xxxxx\ & O614Epic & .xlsx'!$A:$K, 3, FALSE)
=VLOOKUP('Driver(s)'!$G$3, 'S:\xxxxx\ & INDIRECT(B1) & Epic.xlsx'!$A:$K, 3, FALSE)

Sub Test()
    Dim ws As Worksheet
    Dim location_string As String
    Dim myformula As String

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    Set ws = ThisWorkbook.Sheets("%")
    location_string = ws.Cells(2, "E").Value '~~> I'd suggest you use Value

    myformula = "=IFERROR((VLOOKUP($C7,'S:\xxxx\xxxx\xxxx\xxxx\xxxxx\[xxxxxx.xlsx]" & _
        location_string & "'!$A:$K,11,FALSE)),"" - "")"

    Range("F7:F138").Formula = myformula
    Msgbox "Done"

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub