自定义function错误的数据types – 为什么？ 另外如何debugging？

我已经写了一个自定义函数，我不知道如何找出问题。 如果有人知道它为什么会出错，那肯定是有兴趣的，这样我才能使它工作。 但是本着学习钓鱼的精神，我还需要知道下一次如何解决这个问题。 如果我将其更改为一个子，并取消注释testingvariables部分（并在最后注释函数=行，所以sub不抱怨它），我完全使用它。

如果我转到表单并将函数放入与testing部分中的信息相同的单元格中，则会引发错误的数据types错误。 我尝试设置断点来通过，但它并不事件显然screenupdating = false。

它的作用 – 如果重要的话 – 我经常在post中看到这样的想法，我会先占先机。 跳过这部分，如果没关系。 :-)基本上，它翻转了查找周围，以便倒序查找（Q25：Q43，R25：V43，N25,5）将单元格N25看作string，然后使用q25中的string列表：q43作为子stringsearch的一部分。 如果发现匹配，则返回匹配所在的第5列的值。 如果找不到匹配项，则逐行查看r25：v43中的值，扩展逗号分隔的行以find最匹配的行。 其对于没有规范化文本的订单。

因此N25号红色卡车truck001将被列Q中的零件清单重复地查看，如果有卡车001，则将返回第5列（价格）。 如果不是这样，它会通过r：v来查看是否有卡车，然后所有这些都会查看颜色和其他描述符。 这样如果我们得到消防车truck001红色或卡车，火灾，红色truck001它发现它。 同样，如果我们继续看到相同的缩写或拼写错误，我们可以用逗号分隔，以便red和redd能够在两者都在同一个单元格中时find匹配项。

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 [e-mail] 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 

跳过了很多过时的代码