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

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 

我沒有測試這一點，因爲我沒有相應的數據。發表評論，如果你需要幫助。