如果 10 行符合某个条件，Excel VBA 返回真或假

Question

情况： 我为手术室做报告，如果它们符合某些标准，我会给他们使用许可。其中一个标准是每分钟允许大约 100 万个粒子流入/流出房间。用于测量此值的部分计数器输出可在 Excel 中打开的数据表。机器每分钟计算一次颗粒，它就会在数据表中添加一个新行，显示它计算了多少个颗粒。

为了给手术室使用许可，计数器必须连续 10 分钟输出几乎完全相同的 100 万分（偏移 10.000 分 +- 允许）。

我需要什么： 我需要一个可以比较前 10 行数据的代码（从第 3 行开始）。如果它们符合条件（偏移量为 10.000），则填充这些行的单元格 vbGreen。如果它们不匹配，请转到下一行（行：4）并比较接下来的 10 行。如果它们匹配填充那些行 vbGreen。如果它们不匹配，则移至下一行（第 5 行），依此类推。

如果没有匹配，则填充 cellA1 vbRed。

示例表： 0.3 微米（计数）行是我们要比较的行。此表的第一行是 excel 中的第 3 行。在单元格 C1 中，我应该能够输入这个所需的值（现在假定为 100 万）。如前所述，如果没有匹配项，单元格 A1 应变为 vbRed。

Time Stamp | Location 2 | Location 2 | Location 2 | Location 2 | Location 2
-----------| 0.3 micron | 0.3 micron | 0.5 micron | 0.5 micron | Temerature
-----------| (counts)   | (p/ft^3)   | (counts)   | (p/ft^3)   | (F)       
___________|____________|____________|____________|____________|____________
7/6/2016   |  1555000   | 186600000.0|    800000  | 96000000.0 | 75.2
___________|____________|____________|____________|____________|____________
7/6/2016   |  800000    | 96000000.0 |    400000  | 48000000.0 | 75.2
___________|____________|____________|____________|____________|____________
7/6/2016   |  1555000   | 186600000.0|    800000  | 96000000.0 | 75.6
___________|____________|____________|____________|____________|____________
7/6/2016   |  1010000   | 121200000.0|    800000  | 96000000.0 | 75.2
___________|____________|____________|____________|____________|____________
7/6/2016   |  1009000   | 121080000.0|    800000  | 96000000.0 | 75.2
___________|____________|____________|____________|____________|____________
7/6/2016   |  1003000   | 120360000.0|    800000  | 96000000.0 | 75.2
___________|____________|____________|____________|____________|____________
7/6/2016   |   991000   | 118920000.0|    800000  | 96000000.0 | 75.6
___________|____________|____________|____________|____________|____________
7/6/2016   |  1008000   | 120960000.0|    800000  | 96000000.0 | 75.2
___________|____________|____________|____________|____________|____________
7/6/2016   |  1009000   | 121080000.0|    800000  | 96000000.0 | 75.2
___________|____________|____________|____________|____________|____________
7/6/2016   |  1010000   | 121200000.0|    800000  | 96000000.0 | 75.2
___________|____________|____________|____________|____________|____________
7/6/2016   |  1004000   | 120480000.0|    800000  | 96000000.0 | 75.2
___________|____________|____________|____________|____________|____________
7/6/2016   |  1000000   | 120000000.0|    800000  | 96000000.0 | 75.2
___________|____________|____________|____________|____________|____________
7/6/2016   |  1002000   | 120240000.0|    800000  | 96000000.0 | 75.2
___________|____________|____________|____________|____________|____________
7/6/2016   |  1014000   | 121680000.0|    800000  | 96000000.0 | 75.6
___________|____________|____________|____________|____________|____________

续： 我不知道从哪里开始或如何调用这样的函数。这个网站教会了我很多东西，但我找不到和创建这样的东西。

我愿意接受任何建议。

Answer 1

您可以AutoFilter()，如下所示（请参阅 cmets 以根据您的实际需要调整代码）：

Sub main()
    Dim area As Range
    Dim ppm As Double
    Dim found As Boolean

    With Worksheets("Rooms") '<--| change "Rooms" to your actual worksheet name
        ppm = .Range("C1").Value
        With .Range("F2", .Cells(.Rows.count, 1).End(xlUp)) '<--| assuming data are in columns A to F and start at row 3 -.> headres in row 2
            .AutoFilter field:=2, Criteria1:=">=" & ppm * 0.9, Operator:=xlAnd, Criteria2:="<=" & ppm * 1.1
            If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then
                For Each area In .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Areas
                    If area.Rows.count > 9 Then
                        area.Interior.Color = vbGreen
                        found = True
                        Exit For
                    End If
                Next
            End If
        End With
        .AutoFilterMode = False
        .Range("A1").Interior.Color = IIf(found, vbGreen, vbRed)
    End With
End Sub

Answer 2

您可以通过遍历行（第 2 行到最后一行减去 10）的循环来做到这一点。在循环中，将有一个嵌套循环遍历接下来的 9 行并检查是否满足条件。不满足条件时使用伪继续语句。让着色代码在嵌套循环之后进行，因此仅在满足条件时才执行。

至于红色单元格，万一没有匹配，一个简单的布尔标志就可以了。

代码大纲：

Sub doThis()

    dim found as boolean
    found = false

    dim i as long, j as long, lastline as long
    lastline = mySheet.Range(relevantRange).End(xlUp).row

    for i = 2 to lastline - 10
        for j = i to 10
            if not (cells(i, relevantColumn) + 10001 > cells(j, relevantColumn) _
                and cells(i, relevantColumn) - 10001 < cells(j, relevantColumn)) then
                GoTo continue
            end if
        next
        range(relevantColumn & i & ":" & relevantColumn & i + 9).Interior.ColorIndex = vbGreen
        found = true
        exit sub
continue:
    next

    if not found then
        'coloring code
    end if

End Sub

我没有对此进行测试，因为我没有适当的数据。如果您需要帮助，请发表评论。