Question

我写了一个自定义函数，我不知道如何找出问题。如果有人知道它为什么会出错，那肯定会引起人们的兴趣，这样我才能让它发挥作用。但是本着学习钓鱼的精神，我还需要知道如何在下次自己解决这个问题。如果我将它更改为sub并取消注释测试变量部分（并在最后注释function = line，以便sub不会抱怨它）我完全使用它。

如果我转到工作表并将函数放入具有与测试部分相同信息的单元格中，则会抛出错误的数据类型错误。我尝试设置断点来逐步完成，但事件显然不会出现screenupdating = false。

它做了什么 - 如果它很重要 - 我经常在帖子中看到这一点，因此我认为它是先发制人的。如果不重要，请跳过此部分。 :-) 基本上它会翻转vlookup，以便= InvertedVLookup（Q25：Q43，R25：V43，N25,5）将单元格N25视为字符串，然后使用q25：q43中的字符串列表作为子字符串搜索的一部分。如果找到匹配项，则返回匹配所在的第5列的值。如果它没有找到匹配项，则会逐行查看r25：v43中的值，展开逗号分隔的行以查找匹配最多的行。它适用于没有标准化文本的订单。

N25中的Red Fire Truck truck001将在Q列的零件清单中反复查看，如果有卡车001，它将返回第5列（价格）。如果没有它会通过r：v查看任何有卡车的任何人，那么任何做过它的人都会看到颜色和其他描述符。这样，如果我们得到消防卡车truck001红色或卡车，火，红色卡车001它找到它。同样，如果我们继续看到相同的缩写或拼写错误，我们可以用逗号分隔，以便red，redd会找到匹配，而两者都在同一个单元格中。

Public Function InvertedVLookup(Substrings_Array As Variant, Table_Array As Variant, Target_String As String, Column_Index_To_Return As Integer, Optional Approx_Match As Boolean = True)
'by rodger.tampa@gmail.com

    Application.ScreenUpdating = False

    Dim sResult
    Dim LB As Integer, UB As Integer, LB2 As Integer, UB2 As Integer, iMax As Integer
    Dim bDuplicate As Boolean
    Dim ws As Worksheet
    Dim aExpanded_Table_Array
    Set ws = ActiveSheet
    Dim aTableDelimitersExpanded()
    Dim aApproxMatch() As Integer

    '    ' =========== test variables ==== comment out when using function instead of sub ==============
    '    Dim Substrings_Array  As Variant
    '    Dim Table_Array  As Variant
    '    Dim Target_String As String
    '    Dim Column_Index_To_Return As Integer
    '    Dim Approx_Match As Boolean
    '    Substrings_Array = ws.Cells.Range("Q25:Q43")
    '    Table_Array = ws.Cells.Range("R25:V43")
    '    Target_String = ws.Cells.Range("N26").Value
    '    Column_Index_To_Return = 5
    '    Approx_Match = True
    '    ' =========== test variables ==== comment out when using function instead of sub ==============


    bDuplicate = False
    iMax = 0

        LB = LBound(Substrings_Array)
        UB = UBound(Substrings_Array)
        LB2 = LBound(Table_Array, 2)
        UB2 = UBound(Table_Array, 2)

    Dim strTemp As String
    For i = LB To UB
        If IsNull(Substrings_Array(i, 1)) = False Then
            If InStr(LCase(Target_String), LCase(Substrings_Array(i, 1))) > 0 Then
                sResult = i
                Exit For
            End If
        Else
            sResult = "Target String Null"
            GoTo ErrorHandling
        End If
    Next i

    If IsEmpty(sResult) = True Then
        If Approx_Match = True Then
            ReDim Preserve aTableDelimitersExpanded(LB To UB, LB2 To UB2)
            ReDim aApproxMatch(1 To UB, 1 To 1)
            Dim str
            Dim strSplit() As String

            'Check for and total the number of matching qualifiers
            For i = LB To UB
                For j = LBound(Table_Array, 2) To UBound(Table_Array, 2)
                    strSplit = Split(Table_Array(i, j), ", ")
                    For k = LBound(strSplit) To UBound(strSplit)
                        If IsNull(strSplit(k)) = False Then
                            If InStr(LCase(Target_String), LCase(strSplit(k))) > 0 Then
                                aApproxMatch(i, 1) = aApproxMatch(i, 1) + 1
                            End If
                        End If
                    Next k
                Next j
            Next i

            'look at aApproxMatch table for highest value to indicate best match
            For i = LB To UB
                If aApproxMatch(i, 1) > iMax Then
                    iMax = aApproxMatch(i, 1)
                    sResult = i
                    bDuplicate = False
                ElseIf aApproxMatch(i, 1) = iMax Then
                    bDuplicate = True
                End If
            Next i

            'check for ties based on qualifiers
            If bDuplicate = True Then
                sResult = "Multiple Matches"
                GoTo ErrorHandling
            End If
        Else
            sResult = "No Match"
            GoTo ErrorHandling
        End If
    End If

    'return the result
    sResult = Table_Array(sResult, Column_Index_To_Return)

ErrorHandling:
    'If sResult = "Target String Null"
    'If sResult = "No Match"
    'If sResult = "Multiple Matches"

    InvertedVLookup = sResult
    Application.ScreenUpdating = True
End Function

Answer 1

这应该按照需要运作：

Public Function InvertedVLookup(Substrings_Array As Variant, Table_Array As Variant, Target_String As String, Column_Index_To_Return As Integer, Optional Approx_Match As Boolean = True)
  Dim sResult
  Dim Bou(2) As Long
  Dim aApproxMatch() As Integer
  Dim strSplit() As String
  Bou(0) = LBound(Substrings_Array.Value)
  Bou(1) = UBound(Substrings_Array.Value)
  For i = Bou(0) To Bou(1)
    If IsNull(Substrings_Array(i, 1)) Then
      InvertedVLookup = "Target String Null"
      Exit Function
    Else
      If InStr(LCase(Target_String), LCase(Substrings_Array(i, 1))) Then
     'If InStr(1, Target_String, Substrings_Array(i, 1), 1) Then '<~~~ better use this than LCase
        sResult = i
        Exit For
      End If
    End If
  Next i
  If IsEmpty(sResult) Then
    If Approx_Match Then
      ReDim aApproxMatch(1 To Bou(1), 1 To 1)
      For i = Bou(0) To Bou(1)
        For j = LBound(Table_Array.Value, 2) To UBound(Table_Array.Value, 2)
          strSplit = Split(Table_Array(i, j), ", ")
          For k = LBound(strSplit) To UBound(strSplit)
            If Not IsNull(strSplit(k)) Then
              If InStr(LCase(Target_String), LCase(strSplit(k))) Then
             'If InStr(1, Target_String, strSplit(k), 1) Then '<~~~ better use this than LCase
                aApproxMatch(i, 1) = aApproxMatch(i, 1) + 1
              End If
            End If
          Next k
        Next j
      Next i
      For i = Bou(0) To Bou(1)
        If aApproxMatch(i, 1) > Bou(2) Then
          Bou(2) = aApproxMatch(i, 1)
          sResult = i
        ElseIf aApproxMatch(i, 1) = Bou(2) Then
          InvertedVLookup = "Multiple Matches"
          Exit Function
        End If
      Next i
    Else
      InvertedVLookup = "No Match"
      Exit Function
    End If
  End If
  InvertedVLookup = Table_Array(sResult, Column_Index_To_Return)
End Function

删掉了很多过时的代码......

自定义功能错误的数据类型 - 为什么？还有如何调试？

1 个答案: