Question

我有这个UDF，我用它来查找日期并根据条件返回值基本上只有两（2）个条件，<或>日期此外，我也使用内置的Excel函数，只是添加了一些条件。

Public Function CLOOKUP(lookup_value, table_array As Range, column_index As Long, _
                        rv_operator, reference_value, Optional range_lookup, _
                        Optional return_index) As Variant

Dim NT_array, S_array
Dim ORGLOOKUP, REFLOOKUP
Dim row_count As Long, row_less As Long

With Application.WorksheetFunction
    If column_index > 0 And column_index <= table_array.Columns.Count Then

        On Error Resume Next
        ORGLOOKUP = .VLookup(lookup_value, table_array, column_index, range_lookup)
        If Err.number <> 0 Then CLOOKUP = CVErr(xlErrNA): Exit Function
        On Error GoTo 0

        Select Case rv_operator
        Case "<"
            Do While ORGLOOKUP > reference_value
                Set NT_array = table_array.Resize(, 1)
                row_count = .CountA(NT_array)
                Set S_array = table_array.Resize(row_count)
                row_less = .Match(lookup_value, NT_array, 0)
                Set table_array = S_array.Offset(row_less, 0).Resize(row_count - row_less)

                On Error Resume Next
                ORGLOOKUP = .VLookup(lookup_value, table_array, column_index, range_lookup)
                If Err.number <> 0 Then CLOOKUP = CVErr(xlErrNA): Exit Function
                On Error GoTo 0
            Loop
        Case ">"
            Do While ORGLOOKUP < reference_value
                Set NT_array = table_array.Resize(, 1)
                row_count = .CountA(NT_array)
                Set S_array = table_array.Resize(row_count)
                row_less = .Match(lookup_value, NT_array, 0)
                Set table_array = S_array.Offset(row_less, 0).Resize(row_count - row_less)

                On Error Resume Next
                ORGLOOKUP = .VLookup(lookup_value, table_array, column_index, range_lookup)
                If Err.number <> 0 Then CLOOKUP = CVErr(xlErrNA): Exit Function
                On Error GoTo 0
            Loop
        Case Else
            CLOOKUP = CVErr(xlErrNA)
        End Select

        Select Case True
        Case IsMissing(return_index)
            CLOOKUP = ORGLOOKUP
        Case Else
            If return_index <= table_array.Columns.Count Then
                REFLOOKUP = .VLookup(lookup_value, table_array, return_index, range_lookup)
                CLOOKUP = REFLOOKUP
            Else
                CLOOKUP = CVErr(xlErrNA)
            End If
        End Select
    Else
        CLOOKUP = CVErr(xlErrNA)
    End If
End With

End Function

它工作正常但我想稍微优化一下以提高计算速度通常我用它在600k或更多行的excel文件中查找10k行排序数据需要5~8分钟如果有人能指出我如何优化这个功能的正确方向，那就太棒了。

EDIT1：

HERE是工作簿链接两（2）张表，数据源和查找数据，我猜是不言自明的。
我还在WB中包含了该功能我使用该函数填充制造日期列下的查找数据表上的值，并将第一个单元格保留为实际公式，以避免打开它时出现问题。
对于那些不热衷的人，这里有关于如何使用该功能的语法：

lookup_value - 你在寻找什么 table_array - 你在哪里看 column_index - 您希望根据lookup_value获取信息的列 rv_operator - 判断返回值是否小于或大于reference_value的标准 reference_value - 比较返回值的位置
range_lookup - 完全匹配或近似匹配
return_index - 替代列索引，以防万一你需要返回从column_index得到的数据

请记住，我使用它来获取DATES，因此column_index始终包含日期和reference_value。
这就是return_index的原因，因为我可能需要恢复属于条件但实际上对日期不感兴趣的信息。

例如，在我的示例工作簿中，我需要获得序列号096364139403422056的制造日期，但它应小于参考值1/4/2014。
这个序列号有多个出现，所以我需要得到最接近参考值结果应该是11/15/2013使用函数：=CLOOKUP(B2,'Source Data'!A:B,2,"<",A2,0) 希望上面的解释能帮到你们一点。

顺便说一句，这也可以使用Array Formulas来实现我刚刚为不熟悉AF's的其他用户制作了这个公式。

Answer 1

我已经在我的笔记本电脑中创建了一个大约需要40秒的解决方案。我的笔记本电脑大约需要7分钟才能将公式复制到所有查找行。

当我测量原始UDF中的各种瓶颈时，我发现VLOOKUP非常昂贵。使用靠近底部的行的示例：

VLOOKUP：31 ms
COUNTA：7.8 ms
匹配：15毫秒

由于您可能会多次调用上述函数（当存在重复时），因此更耗时。

我的解决方案是使用VBA宏而不是优化UDF。另外，我使用Scripting.Dictionary对象来存储所有序列号，而不是使用VLOOKUP。根据{{3}}，使用Scripting.Dictionary进行查找的速度要快100倍。

我在Windows 7上运行的Office 2010上测试了它。将所有序列号加载到Dictionary中大约需要37秒，而查找和填充列C大约需要3秒！因此，在查找工作表中拥有更多行根本不是问题！

如果宏在创建Scripting.Dictionary时抱怨，您可能需要添加对Microsoft Scripting Runtime的引用（有关详细信息，请参阅上面的链接）。

当我将结果与您的UDF公式进行比较时，我发现一些不一致可能是由于您的UDF代码中的错误。例如：

在行12739，序列号096364139401213204中，参考日期是2013年1月13日，数据是2013年1月3日和2013年4月23日，但结果是#VALUE！所以看起来如果任何数据都比参考日期更大，你希望结果是#VALUE！
但是，在第12779行，序列号为096364139508732708，参考日期是2013年1月9日，数据是8/10/2013和1/2/2013，您的UDF生成1/2/2013而不是#VALUE！即使有一行Mfg日期大于参考日期。

我不知道你想要什么行为，所以我假设你想要显示#VALUE！当任何数据大于参考日期时。如果你想改变这种行为，请告诉我，或者自己更新代码（我在代码中加了大量的评论）。

以下是将电子表格和宏下载到How to optimize vlookup for high search count ? (alternatives to VLOOKUP)的链接。我打算让它只用一个星期。宏代码如下：

Option Explicit
Sub Macro1()
'
' Macro1 Macro
'
Const COMPARISONMODE = "<"
Const SOURCESHEETNAME = "Source Data"
Const LOOKUPSHEETNAME = "Data for Lookup"

Dim oSource
Set oSource = CreateObject("Scripting.Dictionary")

Dim starttime, endtime, totalindex


'BUILD THE INDEX in oSource
'Column A = serial number
'Column B = mfg date
'Column C = extra data
'Each item contains a comma separated list of row numbers
starttime = Timer

Sheets(SOURCESHEETNAME).Activate
Dim rownum, serialno, mfgdate
rownum = 2
Do
  serialno = Cells(rownum, 1)
  If Not IsError(serialno) Then
    serialno = CStr(serialno)
    If serialno = "" Then Exit Do
    If oSource.Exists(serialno) Then
      oSource(serialno) = oSource(serialno) & "," & rownum
    Else
      oSource.Add serialno, CStr(rownum)
    End If
  End If
  rownum = rownum + 1
Loop

endtime = Timer

totalindex = endtime - starttime

starttime = Timer

'DO THE LOOKUP
'NOTE: Assume that there are no #VALUE! in columns A and B of the lookup table
Dim rownumlist, sourcerownum, aryRownumlist, refdate, closestmfgdate, closestextradata, j
Sheets(LOOKUPSHEETNAME).Activate
rownum = 2
Do
  refdate = CDate(Cells(rownum, 1))
  serialno = Cells(rownum, 2)
  If serialno = "" Then Exit Do
  If Not oSource.Exists(serialno) Then
    Cells(rownum, 3) = CVErr(xlErrNA)
    GoTo ContinueLoop
  End If
  aryRownumlist = Split(oSource(serialno), ",")
  closestmfgdate = ""
  closestextradata = ""
  'Find the closest manufacturing date to the reference date out of all matches
  For j = LBound(aryRownumlist) To UBound(aryRownumlist)
    sourcerownum = CLng(aryRownumlist(j))
    mfgdate = Sheets(SOURCESHEETNAME).Cells(sourcerownum, 2)
    If IsError(mfgdate) Then Exit For  'if any of the date in the matches is not valid, output N/A
    mfgdate = CDate(mfgdate)
    'Exclude depending on COMPARISONMODE
    'must be less than the reference date if COMPARISONMODE = "<", otherwise it has to be greater than
    'If comparison failed for ANY of the matches, we will output N/A
    'If you want the failed comparison match to be excluded but still output a date, instead of doing
    '   Exit For, you can do Goto ContinueFor.  Example:
    '      If mfgdate >= refdate Then Goto ContinueFor
    'QUESTION: What to do if it is equal?  Assume that we will output N/A as well
    If COMPARISONMODE = "<" Then
      If mfgdate >= refdate Then closestmfgdate = "": Exit For
    Else
      If mfgdate <= refdate Then closestmfgdate = "": Exit For
    End If
    'Now check whether it is closer to refdate
    If closestmfgdate = "" Then
        closestmfgdate = mfgdate
        closestextradata = Sheets(SOURCESHEETNAME).Cells(sourcerownum, 3)
    ElseIf Abs(DateDiff("d", closestmfgdate, refdate)) > Abs(DateDiff("d", mfgdate, refdate)) Then
        closestmfgdate = mfgdate
        closestextradata = Sheets(SOURCESHEETNAME).Cells(sourcerownum, 3)
    End If
ContinueFor:
  Next
  If closestmfgdate = "" Then
    Cells(rownum, 3) = CVErr(xlErrNA)
    Cells(rownum, 4) = ""
  Else
    Cells(rownum, 3) = closestmfgdate
    Cells(rownum, 4) = closestextradata
  End If
ContinueLoop:
  rownum = rownum + 1
Loop


endtime = Timer

MsgBox "Indexing time=" & totalindex & " seconds; lookup time=" & (endtime - starttime) & " seconds"

End Sub

如果您发现上述解决方案令人满意，请奖励赏金或至少接受解决方案。感谢。

如何优化此UDF

1 个答案: