如何在这段代码中实现一个函数，而不是input一堆“或”语句？

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！

我如何创build和填充列表，制作一个复制我上面的函数，并使用函数迭代列表？

非常感谢大家！

Answer 1

build立一个50个可能的数组循环。 一find就退出循环。

 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

这是它自己的问题。 它属于它自己的范围。 我使用这样的function，如短路，否则多余的条件 – 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的答案那样传递一个数组的值。 原则是一样的：只要你知道你的结果， 即使要评估的第一个布尔expression式为True ，您当前的代码也会执行每个InStr语句。

如果任何项目匹配指定的string，该函数返回True 。 有时你可能需要一个返回True的函数，如果任何项目包含指定的string。 这是另一个function：

 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仓库中 。}

Answer 3

您的50个帐户可能在您的工作表中可用的列表中。 您可以创build一个强大的这些帐户，并使用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