excel - 索引匹配其他表中的数字，如果找不到，则匹配前 3 位数字

好的，这里是对UDF的介绍。如果该功能不能完全满足您的要求，请多多包涵。事实上，我不介意，因为目标不是提供解决方案，而是提供介绍。首先，这是一个代码转储。将其全部安装在工作簿的标准代码模块中。那是一个以前不存在的模块。您需要创建它，它的名称将是Module1. 你可以重命名它。

代码仅凭其存在将无济于事。以 XLSM 格式保存您的工作簿。

Option Explicit

Private Sub TestUdf()
    ' 020
Dim Criteria As Range
Dim FirstTblID As Integer
Dim NumTables As Integer

Set Criteria = Range("A20")
FirstTblID = 1
NumTables = 3
Debug.Print Lowest(Criteria, FirstTblID, NumTables)

End Sub

Function Lowest(Criteria As Range, _
                FirstTblID As Integer, _
                NumTables As Integer) As Double
    ' 020

    Dim Fun As Double                   ' function return value
    Dim Crit As String                  ' value of the received range "Criteria"
    Dim SearchRng As Range              ' range to search in
    Dim Fnd As Range                    ' Cell where match was found
    Dim LookUp As Double                ' individual lookup value
    Dim i As Integer                    ' loop counter

    Crit = Criteria.Value
    For i = FirstTblID To (FirstTblID + NumTables - 1)
        Set SearchRng = ActiveSheet.ListObjects("Table" & i).DataBodyRange.Columns(1)
        Set Fnd = SearchRng.Find(What:=Crit, _
                                 After:=SearchRng.Cells(SearchRng.Cells.Count), _
                                 LookIn:=xlValues, _
                                 LookAt:=xlWhole, _
                                 SearchOrder:=xlByRows, _
                                 SearchDirection:=xlNext, _
                                 MatchCase:=False)
        If Fnd Is Nothing Then
            ' if the Find wasn't successful
            LookUp = FindAverage(Crit, SearchRng)
        Else
            LookUp = Fnd.Offset(0, 2).Value
        End If
        If Fun = 0 Or LookUp < Fun Then Fun = LookUp
    Next i

    Lowest = Fun
End Function

Private Function FindAverage(ByVal Criteria As Variant, _
                             Rng As Range) As Double
    ' 020

    Dim Fun As Double                   ' function return value
    Dim Arr As Variant                  ' table data range
    Dim Total As Double, n As Integer   ' calculate average
    Dim R As Long                       ' row counter

    ' truncate Criteria to the first 3 charcte4rs
    Criteria = Left(Criteria, 3)
    ' expand the range to include the 3rd column
    Arr = Rng.Resize(Rng.Rows.Count, 3).Value

    ' loop through all the cell values
    For R = 1 To UBound(Arr)
        ' compare the first 3 characters case insensive
        If InStr(1, Arr(R, 1), Criteria, vbTextCompare) = 1 Then
            ' skip if there is no value in the 3rd column
            If Val(Arr(R, 3)) Then
                Total = Total + Arr(R, 3)
                n = n + 1
            End If
        End If
    Next R

    ' return zero if no qualifying values were found
    If n Then FindAverage = Total / n
End Function

也许您需要了解的第一件事是代码没有指定要查看的工作表。那是因为它是作为 UDF 设计的。它期望从调用它的工作表中获取指令。但是上面的第一个过程，被调用的过程不会TestUdf从工作表中调用。您可以将其用于测试 - 经过一些调整。

该行Debug.Print Lowest(Criteria, FirstTblID, NumTables)会将类似于您当前公式的结果的内容打印到即时窗口。这是 VB 编辑器屏幕底部的窗格。此函数调用有 3 个参数，您可以在过程中设置Criteria，FirstTblID和NumTables。第一个是包含查找值的单元格，例如 2990001。另外两个用于显示灵活性。

我将您的 3 个表命名为Table1,Table2和Table3。因此，第一个表是 #1，表的总数是 3。想法是您可以在表 14 到 18 上使用相同的函数。在这种情况下，FirstTblID将是 14 和NumTables5。该函数将返回最低的5个值。

在 VBA 中，所有这些都很好地展开并使用命名变量进行解释以提供指导和注释以提供帮助。当您从工作表中调用该函数时，没有多余的装饰。在这种情况下， Cell(A20) 位于第 4 个表格的第一列。该函数将进入第三列。从那里可以像任何其他 Excel 函数一样上下复制它。

[C20] = Lowest(A20, 1, 3)

现在，该函数返回从 3 个表中获取的 3 个值中的最小值（请记住重命名它们！）但是这里出现了您现在要询问的修正。这只是现有程序流程的一个小改动。这里是。

If Fnd Is Nothing Then
    ' if the Find wasn't successful
    LookUp = FindAverage(Crit, SearchRng)
Else
    LookUp = Fnd.Offset(0, 2).Value
End If
If Fun = 0 Or LookUp < Fun Then Fun = LookUp

在这里，您可以看到 VBA 通过合理的努力启用了一种与单一工作表函数支持完全不同的方法。上面的代码分别决定了三个值中的每一个。如果无法找到其中一个，则仅将一个值替换为基于前 3 位的相似值的平均值。我知道这不是你要的，但我想你可能不敢问。在 VBA 中，这很容易，当然，创建您确实要求的结果只是一个小改动。

在我的代码中，另一种计算方式包含在名为FindAverage. 原始函数仅在需要时调用它，但出于维护目的，它是一个单独的函数，您可以将其提供给其他函数。事实上，您也可以从工作表中调用此函数。该调用如下所示，但您需要Private从其声明行中删除，以便可以从工作表中看到它。

=FindAverage(A20,Table1[Ref-ID])

根据您的建议，这里是按名称命名表的代码。请注意，函数的名称（此处Lowest2为）在最后一行代码中重复出现。

Function Lowest2(Criteria As Range, _
                 FirstTblID As Integer, _
                 NumTables As Integer) As Double
    ' 020 (with named tables)

    Dim Fun         As Double           ' function return value
    Dim Tbls()      As String           ' list of tables
    Dim Crit        As String           ' value of the received range "Criteria"
    Dim SearchRng   As Range            ' range to search in
    Dim Fnd         As Range            ' Cell where match was found
    Dim LookUp      As Double           ' individual lookup value
    Dim i           As Integer          ' loop counter

    Tbls = Split("Table1,Table2,Table3,Table4,Table5", ",")
    Crit = Criteria.Value
    For i = FirstTblID To (FirstTblID + NumTables - 1)
        Set SearchRng = ActiveSheet.ListObjects(Trim(Tbls(i - 1))).DataBodyRange.Columns(1)
        Set Fnd = SearchRng.Find(What:=Crit, _
                                 After:=SearchRng.Cells(SearchRng.Cells.Count), _
                                 LookIn:=xlValues, _
                                 LookAt:=xlWhole, _
                                 SearchOrder:=xlByRows, _
                                 SearchDirection:=xlNext, _
                                 MatchCase:=False)
        If Fnd Is Nothing Then
            ' if the Find wasn't successful
            LookUp = FindAverage(Crit, SearchRng)
        Else
            LookUp = Fnd.Offset(0, 2).Value
        End If
        If Fun = 0 Or LookUp < Fun Then Fun = LookUp
    Next i

    Lowest2 = Fun
End Function

我保持函数调用与原始函数调用相同，但添加了一行代码，您可以在其中指定表名。

Tbls = Split("Table1,Table2,Table3,Table4,Table5", ",")

无论您的表名称是什么，您都可以在此处列出它们，并以逗号分隔。您可以指定Split("Mary,Tom,Mary S,Thomas,Bangkok", ",").

现在，函数调用Lowest2(A20,1,3)指定此列表中的第一个表为1，表的数量为3。这意味着列表中的 Table4 和 Table4 都未使用。但您也可以调用Lowest2(A20,1,5)或实际上Lowest2(A20,1,1)从一个表中获取单个值。您可以调用Lowest2(A20,3,3)从表 3 到 5 中获取值。您无法从表 1、3 和 5 中获取值，但这也只是另一个小改动。

excel - 索引匹配其他表中的数字，如果找不到，则匹配前 3 位数字

问题描述

解决方案

推荐阅读