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以支持传递像@Jeeped's answer这样的一维数组;原则是一样的：一旦你知道你的结果就纾困;您当前的代码将执行每个InStr语句，即使要评估的第一个布尔表达式是True。

如果任何项匹配指定的字符串，该函数将返回True。有时，如果任何项包含指定的字符串，您可能需要一个返回True的函数。那是另一个功能：

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以获得类似的签名）。同样，同样的原则：一旦你知道要返回什么就纾困。

_{¹实际模块为StringType.cls，位于VBTools GitHub repository。}

Answer 3

您的50个帐户可能位于工作表中可用的列表中。您可以创建一个强大的帐户，并使用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中。如果这对您不起作用，请将列表放在另一个工作表上，并按如下所示更改上述代码。

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”语句？

3 个答案: