Question

我在表格中有一个包含3个变量的列表＆＃34;合并＆＃34;在A栏; B;下进行。

工作簿包含98张，其中3个变量仍在A中; B; C列，但是在不同的组合中，并且第四列从不重复自身，因为纸张继续，我需要带来＆＃34;组合＆＃34;工作表，总是为下一个工作表添加另一列我vlookup。：A B C + D（来自下一张）+ E（来自下一张）等等。

我有一个基于3个标准的Vlookups 3的UDF和一个循环通过工作表的宏并将值带到我想要的位置。问题是，它很慢，从昨天开始就把它留在了60页。任何关于改进它的建议都会有很大的帮助，谢谢你提前！

Function ThreeVlookup(Table_Range As Range, Return_Col As Long, Col1_Fnd, Col2_Fnd, Col3_Fnd)
Dim rCheck As Range, bFound As Boolean, lLoop As Long
On Error Resume Next
Set rCheck = Table_Range.Columns(1).Cells(1, 1)
With WorksheetFunction
    For lLoop = 1 To .CountIf(Table_Range.Columns(1), Col1_Fnd)
    Set rCheck = Table_Range.Columns(1).Find(Col1_Fnd, rCheck, xlValues, xlWhole, xlNext, xlRows, False)
        If UCase(rCheck(1, 2)) = UCase(Col2_Fnd) And UCase(rCheck(1, 3)) = UCase(Col3_Fnd) Then
            bFound = True
    Exit For
        End If
    Next lLoop
End With
If bFound = True Then
    ThreeVlookup = rCheck(1, Return_Col)
Else
    ThreeVlookup = ""
End If
End Function

Sub test()
Dim lookupVal1 As Range, lookupVal2 As Range, lookupVal3 As Range, myString As Variant, n&, u As Long
n = Sheets("Combined").[A:A].Cells.Find("*", , , , xlByRows, xlPrevious).Row
u = 4
For j = 2 To Worksheets.Count
For i = 1 To n
    Set lookupVal1 = Sheets("Combined").Cells(i, 1)
    Set lookupVal2 = Sheets("Combined").Cells(i, 2)
    Set lookupVal3 = Sheets("Combined").Cells(i, 3)
        myString = ThreeVlookup(Sheets(j).Range("A:D"), 4, lookupVal1, lookupVal2, lookupVal3)
            Sheets("Combined").Cells(i, u) = myString
Next i
u = u + 1
Next j
End Sub

Answer 1

使用数组加速，我的朋友！将所有工作表（或者只是循环中的当前工作表）加载到VBA内存中的数组中，并在arrayVar（行）上执行.CountIf和.Find而不是Table_Range.Columns（1）。

你会更加惊讶它会更快。做吧！

这是我在数组上喜欢的教程......

http://www.cpearson.com/excel/ArraysAndRanges.aspx

这是一个对像你这样的应用程序进行速度测试的人......

https://fastexcel.wordpress.com/2011/10/26/match-vs-find-vs-variant-array-vba-performance-shootout/

基础知识是这样的：

Sub Play_With_Arrays()

Dim varArray() As Variant
Dim lngArray() As Long
ReDim varArray(1 To 1000)
ReDim lngArray(1 To 1000)

For A = 1 To 1000
    lngArray(A) = A / 2
    varArray(A) = A / 2 & " examples"
Next

searchterm = 345

For B = 1 To 1000
    If lngArray(B) = searchterm Then
       FoundRow = B
    End If
Next

searchterm2 = "5 ex"
FoundStrRowCount = 0

For C = 1 To 1000
    If InStr(1, varArray(C), searchterm2, vbBinaryCompare) Then
        FoundStrRowCount = FoundStrRowCount + 1
    End If
Next

MsgBox (FoundRow & " in long array and " & FoundStrRowCount & " in var array")

End Sub

Answer 2

这样的事情要快得多：

Public Function ThreeVLookup(ByVal arg_Col1LookupVal As Variant, _
                             ByVal arg_Col2LookupVal As Variant, _
                             ByVal arg_Col3LookupVal As Variant, _
                             ByVal arg_LookupTable As Range, _
                             ByVal arg_ReturnColumn As Long) _
  As Variant

    Dim rConstants As Range, rFormulas As Range
    Dim rAdjustedTable As Range
    Dim aTable As Variant
    Dim i As Long

    On Error Resume Next
    Set rConstants = arg_LookupTable.SpecialCells(xlCellTypeConstants)
    Set rFormulas = arg_LookupTable.SpecialCells(xlCellTypeFormulas)
    On Error GoTo 0
    Select Case (Not rConstants Is Nothing) + 2 * (Not rFormulas Is Nothing)
        Case 0:     ThreeVLookup = vbNullString
                    Exit Function
        Case -1:    Set rAdjustedTable = rConstants
        Case -2:    Set rAdjustedTable = rFormulas
        Case -3:    Set rAdjustedTable = Union(rConstants, rFormulas)
    End Select

    If WorksheetFunction.CountIfs(rAdjustedTable.Resize(, 1), arg_Col1LookupVal, rAdjustedTable.Resize(, 1).Offset(, 1), arg_Col2LookupVal, rAdjustedTable.Resize(, 1).Offset(, 2), arg_Col3LookupVal) = 0 Then
        ThreeVLookup = vbNullString
        Exit Function
    End If

    aTable = rAdjustedTable.Value

    For i = LBound(aTable, 1) To UBound(aTable, 1)
        If aTable(i, 1) = arg_Col1LookupVal And aTable(i, 2) = arg_Col2LookupVal And aTable(i, 3) = arg_Col3LookupVal Then
            ThreeVLookup = aTable(i, arg_ReturnColumn)
            Exit Function
        End If
    Next i

End Function

Sub tgr()

    Dim wb As Workbook
    Dim wsCombined As Worksheet
    Dim ws As Worksheet
    Dim aResults() As Variant
    Dim aCombined As Variant
    Dim i As Long, j As Long

    Set wb = ActiveWorkbook
    Set wsCombined = wb.Sheets("Combined")
    aCombined = wsCombined.Range("A1").CurrentRegion.Value
    ReDim aResults(1 To UBound(aCombined, 1) - LBound(aCombined, 1) + 1, 1 To wb.Sheets.Count - 1)

    For i = LBound(aCombined, 1) To UBound(aCombined, 1)
        j = 0
        For Each ws In wb.Sheets
            If ws.Name <> wsCombined.Name Then
                j = j + 1
                aResults(i, j) = ThreeVLookup(aCombined(i, 1), aCombined(i, 2), aCombined(i, 3), ws.Range("A:D"), 4)
            End If
        Next ws
    Next i

    wsCombined.Range("D1").Resize(UBound(aResults, 1), UBound(aResults, 2)).Value = aResults

End Sub

3标准Vlookup宏的改进

2 个答案: