而不是键入一堆 "Or" 语句，我如何在这段代码中实现一个函数？

Question

Sub test()

Dim DataRange As Range
Dim LastRow As Integer
Dim i As Integer
Dim SplitVal() As String
Dim OutputOffset As Long
OutputOffset = 0

LastRow = Cells(Rows.Count, "J").End(xlUp).Row

For i = 2 To LastRow
    If InStr(1, Cells(i, 10).Value, "Test1", vbTextCompare) <> 0 Or 
       InStr(1, Cells(i, 10).Value, "Test2", vbTextCompare) <> 0 Or 
       InStr(1, Cells(i, 10).Value, "Test3", vbTextCompare) <> 0 Then

      SplitVal = Split(Cells(i - 2, 10).Value, " ", 2)
      Cells(i + OutputOffset, 13).Value = SplitVal(0)
      Cells(i + OutputOffset, 14).Value = SplitVal(1)

      Cells(i + OutputOffset, 15).Value = Cells(i + 1, 10).Value
    End If
Next i


End Sub

大家好。因此，正如您所见，我的代码遍历并检查 Test1、Test2 或 Test3。问题是我有 50 多个帐户需要检查，而不是 3 个！

如何创建和填充列表，创建一个函数来复制我上面的内容，并使用该函数迭代列表？

非常感谢大家！

Answer 1

构建一个包含 50 种可能循环的数组。一找到就退出循环

Option Explicit

Sub test()

    Dim DataRange As Range
    Dim lastRow As Long
    Dim i As Integer
    Dim SplitVal() As String
    Dim OutputOffset As Long
    Dim v As Long, tests As Variant
    OutputOffset = 0

    tests = Array("Test1", "Test2", "Test3", "Test4", "Test5", "Test6", "Test7", "Test8", "Test9", _
                  "Test10", "Test11", "Test12", "Test13", "Test14", "Test15", "Test16", "Test17", "Test18", _
                  "Test19", "Test20", "Test21", "Test22", "Test23", "Test24", "Test25", "Test26", "Test27")

    With Worksheets("Sheet1")
        lastRow = .Cells(.Rows.Count, "J").End(xlUp).Row

        For i = 2 To lastRow
            For v = LBound(tests) To UBound(tests)
                If CBool(InStr(1, .Cells(i, 10).Value2, tests(v), vbTextCompare)) Then Exit For
            Next v

            If v <= UBound(tests) Then
                SplitVal = Split(.Cells(i - 2, 10).Value2, " ", 2)
                .Cells(i + OutputOffset, 13).Value = SplitVal(0)
                .Cells(i + OutputOffset, 14).Value = SplitVal(1)
                .Cells(i + OutputOffset, 15).Value2 = .Cells(i + 1, 10).Value2
            End If
        Next i
    End With

End Sub

我添加了一些父工作表引用。

Answer 2

这本身就是一个问题；它属于自己的范围。我使用这样的函数来短路其他冗余条件 - ParamArray 是这里的秘诀：

Public Function MatchesAny(ByVal needle As String, ParamArray haystack() As Variant) As Boolean

    Dim i As Integer
    Dim found As Boolean

    For i = LBound(haystack) To UBound(haystack)
        found = (needle = CStr(haystack(i)))            
        If found Then Exit For
    Next

    MatchesAny = found

End Function

可以这样使用：

If MatchesAny(CStr(ActiveSheet.Cells(i, 10).Value), _
    "Test1", "Test2", "Test3", "Test4", "Test5", _
    "Test6", "Test7", "Test8", "Test9", "Test10", _
    "Test11", "Test12", "Test13", ..., "Test50") _
Then
    'match was found
End If

您可以很容易地调整 haystack 以支持传递一维值数组，例如；原则是一样的：一知道结果就退出；您当前的代码将执行每个 InStr 语句，即使要计算的第一个布尔表达式是 True.

该函数 returns True 如果任何项目匹配指定的字符串。有时您可能需要一个 returns True if any item contains 指定字符串的函数。那是另一个功能：

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

    Dim i As Integer
    Dim found As Boolean

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

    ContainsAny = found

End Function

这一个围绕 InStr 调用了一个简单的包装函数，这有助于提高 InStr() <> 0 调用的可读性：

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)

End Function

它的用法是相似的，除了我们在参数列表之前有一个需要指定的 caseSensitive 参数（您可能想调整 MatchesAny 以具有类似的签名）。同样，同样的原则：一旦知道要做什么就立即退出 return.

Answer 3

您的 50 个帐户可能在您工作中可用的列表中sheet。您可以创建一个 strong of those accounts 并使用 instr 函数来查找是否存在匹配项。

    Sub test()

        Dim DataRange As Range
        Dim LastRow As Integer
        Dim i As Long
        Dim SplitVal() As String
        Dim OutputOffset As Long
        OutputOffset = 0

        Dim Spike As String
        For i = 3 To 11
            Spike = Spike & Cells(i, 1).Value & "|"
        Next i

        LastRow = Cells(Rows.Count, "J").End(xlUp).Row

        For i = 2 To LastRow
            If InStr(Spike, Cells(i, 10).Value) Then
    '        If InStr(1, Cells(i, 10).Value, "Test1", vbTextCompare) <> 0 Or
    '           InStr(1, Cells(i, 10).Value, "Test2", vbTextCompare) <> 0 Or
    '           InStr(1, Cells(i, 10).Value, "Test3", vbTextCompare) <> 0 Then

              SplitVal = Split(Cells(i - 2, 10).Value, " ", 2)
              Cells(i + OutputOffset, 13).Value = SplitVal(0)
              Cells(i + OutputOffset, 14).Value = SplitVal(1)

              Cells(i + OutputOffset, 15).Value = Cells(i + 1, 10).Value
            End If
        Next i

End Sub

在我的示例中，列表位于 ActiveSheet 的 A3:A11 中。如果这对您不起作用，请将列表放在另一个 sheet 上并按如下方式更改上面的代码。

Dim WsList As Worksheet
Dim Spike As String
Set WsList = Worksheets("AccountList")
For i = 3 To 11
    Spike = Spike & WsList.Cells(i, 1).Value & "|"
Next i

而不是键入一堆 "Or" 语句，我如何在这段代码中实现一个函数？

Instead of typing up a bunch of "Or" statements, how can I implement a function in this code?

excel

vba

boolean-logic

excel-formula