使用VBA获取阈值

Question

我有一列A和一列B.在A栏中，我有（从A2开始）从1-150开始的值（因此以A151结尾）

在B栏中，我有价值观。我希望得到第一个值高于单元格Z2中的值，并在单元格B153中为列B写出A列中的对应值。最后一部分很棘手。如果以下4个值也高于Z2中的值，我只想写这个值。这可能是d？

如果是这样，我在C-Y

列中也有相同的内容

更好的解释：

我想循环遍历B-Y列 来自细胞2-151的内环。

如果B2> Z2但接下来的4个连续细胞（B3-B6）> Z2，则将A2复制到B153并移至下一列。 如果B2> Z2但接下来的4不是全部＆gt; Z2，用B3重复处理。 如果B2＆lt; Z2，移至B3。

如果没有，则将N / A复制到B153

可以这样做吗？

我的第一次尝试：

=INDEX($A$2:$A$151,SUMPRODUCT(MATCH(1,--(B$2:B$151>$Z$2),0)),1)

这是第一个值。我试图想出一个聪明的方法来获取第一个值，只有第二个值也符合标准。从那里我确定我可以扩展到第3，第4，第5等等。

Answer 1

您当前的公式可能适用于单值案例，但我认为尝试扩大规模会非常笨拙。通过公式快速实现这一目标的方法有：

=MIN(IF(COUNTIF(INDIRECT("B"&ROW(2:147)&":B"&ROW(6:151)),">"&Z2)=5,$A2:$A147,1E9))

和

=MIN(IF((B2:B147>Z2)*(B3:B148>Z2)*(B4:B149>Z2)*(B5:B150>Z2)*(B6:B151>Z2),$A2:$A147,1E9))

就我个人而言，我认为后者更易于阅读和拖动电子表格（尽管可以修改前者以轻松拖动）。后者还避免了易变INDIRECT函数。第一个函数一次占用5个单元格范围，并计算符合条件的单元格数。如果我们的数量是5，我们有一个匹配。如果您正在寻找更大的匹配集，则首选此方法。第二个公式只是逐步检查范围，通过r到r + 4，其中r是当前行。两者都是应使用CTRL + SHIFT + ENTER而不是ENTER输入的数组公式。

Answer 2

有很多方法可以解决这个问题，但在我看来，你需要在用户定义的函数中使用嵌套循环。

我们可以......

function get_Energy_Row(cellSearch as Range, staticValue as Single)

  Dim cell1 as Single

  get_Energy_Row = "N/A"

  j = 1 
  col = cellSearch.Columns.Count

  Do
      cell1 = cellSearch(j, col) 

      If cell1 <= staticValue Then
          'do nothing, function already set to "N/A"
      Else

          For i = 1 to 4
              If cellSearch(i + j, col) > staticValue Then
                  get_Energy_Row = cellSearch(j,1)
              Else
                  'do nothing, function already set to "N/A"
              End If
          Next i
      End If

      j = j + 1

  Loop Until j >= cellSearch.Rows.Count - 3 Or get_Energy_Row <> "N/A"

End Function

然后在单元格C153中调用您的UDF，如下所示：

=get_Energy_Row($A2:B151,$Z$2)，其中包含第一列。

请注意美元符号，这将确保您的静态检查始终为Z2

逻辑是我将单元格默认为“N / A”，直到找到覆盖“N / A”的条件，在这种情况下循环被破坏。

Answer 3

这样的事情：

Sub OutputEnergy()    
'y = Columns to check: 2-25
'x = Rows to check: 2-152
'z = check the next 4 cells
Dim x, y, z, check
'Clear the range where we store the #N/A or Energy Outputs
Range("B153:Y153") = vbNullString
For y = 2 To 25
    For x = 2 To 152
        If Cells(x, y) > Range("Z2") Then  'If value is greater than Z2
            check = True                   'Let's check the next 4
            For z = 1 To 4                 'If any of them fail
                If Cells(x + z, y) < Range("Z2") Then
                    check = False          'The check fails
                    Exit For
                End If
            Next z
            If check = True Then            'If the check doesn't fail
                Cells(153, y) = Cells(x, 1) 'Set cell 153 to the energy level
                Exit For
            End If
        End If
    Next x                                   'If no energy level was set - #N/A
    If Cells(153, y) = vbNullString Then Cells(153, y) = "#N/A"
Next y
End Sub

编辑：作为功能：

功能用途：

=OutputEnergy(Range, Threshold, [Number of cells to check], [Using Headers?])

基本上，给它检查范围，给它一个阈值。

默认情况下，要检查的单元格数为4。

要获得“能量”，它会得到行号（如果使用标题，则减去1）

Function OutputEnergy(TheRange As Range, Threshold As Variant, Optional NextCells As Integer = 4, Optional OffsetForHeader As Boolean = True) As Variant    
Dim c, x, check
For Each c In TheRange
    If c.Value > Threshold Then
        check = True
        For x = 1 To NextCells
            If c.Offset(x, 0) < Threshold Then
                check = False
                Exit For
            End If
        Next x
        If check = True Then
            OutputEnergy = IIf(OffsetForHeader, c.Row - 1, c.Row)
            Exit Function
        End If
    End If
Next c
OutputEnergy = CVErr(xlErrNA)
End Function

再次修改 - 输出到所有工作表：

OutputEnergyToSheet接受工作表作为参数：

Sub OutputEnergyToSheet(TheSheet As String)
'y = Columns to check: 2-25
'x = Rows to check: 2-152
'z = check the next 4 cells
Dim x, y, z, check
'Clear the range where we store the #N/A or Energy Outputs
With Sheets(TheSheet)
    .Range("B153:Y153") = vbNullString
    For y = 2 To 25
        For x = 2 To 152
            If .Cells(x, y) > .Range("Z2") Then  'If value is greater than Z2
                check = True                   'Let's check the next 4
                For z = 1 To 5                 'If any of them fail
                    If .Cells(x + z, y) < .Range("Z2") Then
                        check = False          'The check fails
                        Exit For
                    End If
                Next z
                If check = True Then                    'If the check doesn't fail
                    .Cells(153, y) = Int(.Cells(x, 1))  'Set cell 153 to the energy level
                    Exit For
                End If
            End If
        Next x                                   'If no energy level was set - #N/A
        If .Cells(153, y) = vbNullString Then .Cells(153, y) = "#N/A"
    Next y
End With
End Sub

OutputEnergyToAllSheets循环遍历每个工作表并调用新的子工作：

Sub OutputEnergyToAllSheets()
Dim w
For Each w In ThisWorkbook.Worksheets
    If Not InStr(w.Name, "Total") > 0 And Not InStr(w.Name, "eV") > 0 Then
        OutputEnergyToSheet w.Name
    End If
Next w
End Sub