Question

我正拼命尝试对自己的代码实施此解决方案：https://stackoverflow.com/a/43196497/11632049

目标是搜索各种字符串（“ ABC”，“ 123”等），如果数据行包含该字符串，则将该行复制到其他工作簿中。我收到未定义的子项或函数错误

Public Function ContainsAny(ByVal needle As String, ByVal caseSensitive As _ 
    Boolean, ParamArray haystack() As Variant) As Boolean

    Dim k As Integer
    Dim found As Boolean

    For k = LBound(haystack) To UBound(haystack)
        found = Contains(needle, CStr(haystack(k)), caseSensitive)
        If found Then Exit For
    Next
    ContainsAny = found

End Function


Private Sub Workbook_AfterSave(ByVal Success As Boolean)

    Dim CoderBook As Workbook
    Dim Review As Workbook
    Dim Alpha As Worksheet
    Dim Coder As Worksheet
    Dim LastRow As Long
    Dim NextRow As Long
    Dim i As Long

    Set CoderBook = Workbooks.Open(FilePath)
    Set Coder = CoderBook.Sheets("Sheet1")

    Set Review = ThisWorkbook
    Set Alpha = Review.Sheets("Sheet5")

    'Search code
    LastRow = Alpha.Cells.Find(What:="*", After:=[A1], _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    Application.ScreenUpdating = False

    'Loop search code
    For i = 2 To LastRow

        If Alpha.Range("G" & i) <> Alpha.Range("H" & i) Or _
        Alpha.Range("J" & i) <> Alpha.Range("K" & i) Then

        Select Case True
        Case ContainsAny(Ophth.Range("H" & i), False, "ABC", "123")

            DuplicateCheck = Application.Match(Alpha.Range("A" & i).Value, _ 
            Coder.Columns(1), 0)
            If IsError(DuplicateCheck) Then
                Coder.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0). _
                EntireRow.Value = Alpha.Rows(i).Value
            End If
        End Select
       End If

    Next i

CoderBook.Close SaveChanges:=True
Application.ScreenUpdating = True
End Sub

Answer 1

由于ContainsAny正在调用已删除的Contains函数，因此出现“未定义函数”的编译错误。重新添加。

found = Contains(needle, CStr(haystack(k)), caseSensitive)

但是，Contains方法的逻辑需要翻转才能使其以您希望的方式使用：

Public Function Contains(ByVal needle As String, ByVal haystack As String, Optional ByVal caseSensitive As Boolean = False) As Boolean

    Dim compareMethod As VbCompareMethod

    If caseSensitive Then
        compareMethod = vbBinaryCompare
    Else
        compareMethod = vbTextCompare
    End If

    Contains = (InStr(1, haystack, needle, compareMethod) <> 0)
    If Not Contains Then Contains = (InStr(1, needle, haystak, compareMethod) <> 0)

End Function

这样，当任一字符串包含另一个字符串时，Contains将返回True，并且您可以这样做：

 If ContainsAny(Ophth.Range("H" & i).Value, False, "ABC", "123", "XYZ") Then

当单元格值包含任何指定的字符串时，条件块将执行。

Answer 2

这似乎正在起作用-我调整了@MathieuGuindon的自定义函数，以尝试为自己澄清我搜索词之间的期望关系：我有一组搜索词，我需要知道它们中的任何一个何时出现在我的数据中

Public Function ContainsAny(ByVal data As String, ByVal caseSensitive _ 
    As Boolean, ParamArray searchterms() As Variant) As Boolean

    Dim k As Integer
    Dim found As Boolean

    For k = LBound(searchterms) To UBound(searchterms)
        found = Contains(data, CStr(searchterms(k)), caseSensitive)
        If found Then Exit For
    Next

    ContainsAny = found

End Function



Public Function Contains(ByVal data As String, ByVal searchterms _
    As String, Optional ByVal caseSensitive As Boolean = False) As Boolean

    Dim compareMethod As VbCompareMethod

    If caseSensitive Then
        compareMethod = vbBinaryCompare
    Else
        compareMethod = vbTextCompare
    End If

    Contains = (InStr(1, data, searchterms, compareMethod) <> 0)

End Function


'implemented as
Case ContainsAny(Alpha.Range("H" & i), False, "ABC", "123", "XYZ)

无法正确获取自定义函数语法：Contains（）

2 个答案: