Question

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

为了给予手术室使用许可，计数器必须在10分钟内完全放置相同的100万（偏移10.000颗粒+ - 允许）颗粒。

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

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

示例表 0.3微米（计数）行是我们想要比较的行。该表的第一行是excel中的第3行。在Cell 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()，如下所示（请参阅评论以根据实际需要调整代码）：

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

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

Excel VBA如果10行符合特定条件，则返回true或false

2 个答案: