Question

我用一个小的脚本完成了95％的工作，该脚本使用与4或5列匹配的输入框条件来返回记录的随机样本。我想要在其他电子表格的单独命名范围中包含单元格值与40或50个不同值之一匹配的行。目前，我正在过滤：在日期范围（基于输入框），业务范围（基于输入框）之间，仅过滤“已批准”的记录（没有输入框，仅明确说明）。我不知道如何匹配满足随时间变化的数十个条件的行-我想更改查找表，而不是在我的代码中手动输入每个查找可能性。

我已经尝试过（Data（i，13）.Value = range（“ AllBands”）。value和许多变体，例如“ in”，“ in”等。

问题：如何通过将第13列中的单元格值与列出了40或50个可接受值的另一个工作簿（称为“ AllBands”）中的命名范围内的单元格值进行匹配，来进一步过滤随机选择？ / strong>

////

Static StartDate As String, LOBName As String, BandName As String, Status As String Static EndDate As String Dim sDate As Date Dim eDate As Date Dim Data, Possible, This Dim i As Long, j As Long Dim Ws As Worksheet Static Amount As Long Dim SheetName As String 'Get the start date of the range you need Do StartDate = InputBox("Enter START date (Format as MM/DD/YYYY)", "Generate Random Sample", StartDate) If StartDate = "" Then Exit Sub If Not IsDate(StartDate) Then Beep Loop Until IsDate(StartDate) 'Get the END date of the range you need Do EndDate = InputBox("Enter END date (Format as MM/DD/YYYY)", "Generate Random Sample", EndDate) If EndDate = "" Then Exit Sub If Not IsDate(EndDate) Then Beep Loop Until IsDate(EndDate) sDate = StartDate eDate = EndDate LOBName = InputBox("Enter LOB you want sampled (SHP, CC, Etc)", "Generate Random Sample", LOBName) If LOBName = "" Then Exit Sub If Amount = 0 Then Amount = 5 'Default Else Amount = Amount + 1 'Adjust from last call (see code below) End If Amount = Application.InputBox("Enter amount (Total number of rows / records you want to return - up to the total number available for date and name parameter)", "Generate Random Sample", Amount, Type:=1) If Amount <= 0 Then Exit Sub 'Read in all data Data = Sheets("Reports").Range("A1").CurrentRegion.Value 'Initialize Amount = Amount - 1 Possible = Array() j = -1 'Collect all row numbers that are possible For i = 2 To UBound(Data) 'Checks in Column 9 for date, checks in column 6 for the LOB that you enter If (Data(i, 9) >= sDate) And (Data(i, 9) <= eDate + 1) And (Data(i, 6) = LOBName And _ (Data(i, 8) = "Approved-PCSP") And (Data(i, 13).Value Like worksheets("LookupFile.xls").range("AllBands"))) _ Then j = j + 1 ReDim Preserve Possible(0 To j) Possible(j) = i End If Next ////

此后还有很多，但这一切对我有用-希望将其保持尽可能小...

Answer 1

假设我已经正确理解了您的问题，那么您正在查看数组元素Data(i, 13)是否在AllBands范围内。

也许您可以更改此位：

And (Data(i, 13).Value Like worksheets("LookupFile.xls").range("AllBands"))

到下面（如果AllBands是一行或一列）：

And IsNumber(Application.Match(Data(i, 13).Value,Worksheets("LookupFile.xls").Range("AllBands"), 0))

或以下（如果AllBands由多列或多行组成）：

And Not (Worksheets("LookupFile.xls").Range("AllBands").Find(Data(i, 13), , xlValues, xlWhole, xlByRows, xlNext, False) Is Nothing)

但是，VBA不提供短路评估。因此，它将始终评估链/系列中的每个布尔表达式。最好将语句弄乱（例如，如果您已经知道日期不在日期范围内，则不必不必要地检查AllBands。

这将意味着：

' Some code here...
If (Data(i, 9) >= sDate) And (Data(i, 9) <= EDate + 1) Then
    If Data(i, 6) = LOBName And (Data(i, 8) = "Approved-PCSP") Then
        If IsNumber(Application.Match(Data(i, 13).Value, Worksheets("LookupFile.xls").Range("AllBands"), 0)) Then
            ' Some code here...
        End If
    End If
End If
' Some code here...

在循环之前将AllBands存储在一个变量中也可能会很好（例如，在循环内部先存储Dim cellsToSearch as range，然后依次访问Set cellsToSearch = Worksheets("LookupFile.xls").Range("AllBands")和cellsToSearch。

如果以上方法对您都行，那就很好。可能无需进一步优化。

以上两种方法都将执行线性搜索（遍历AllBands中的每个值）。最重要的是，线性搜索将针对数组Data中的每一行进行。

如果代码花费的时间太长，也许您可以对AllBands中的数据进行排序以进行二进制搜索（二进制搜索可以通过Application.Vlookup或Application.Match进行，正确的论点，除非我弄错了。

或者可能有必要使用算法复杂度较低的方法，例如dictionary，collection（尽管它不提供contains或exists函数）或内部使用哈希表的任何对象。因此，在循环之前，您需要将AllBands中的所有值添加到字典中（注意是否区分大小写），然后在循环中可以（更快地）检查{{1} }与Data(i, 13)中的任何内容匹配。

在单独的查找表中查找与多个条件匹配的行

1 个答案: