使用VBA获取阈值 [英] Using VBA to get a threshold value
问题描述
<在列B中，我有值。我想得到单元格Z2中的值之上的第一个值，并在单元格B153的列A中的A列中写出对应值。最后一部分是棘手的。如果以下4个值也高于Z2中的值，我只想写入该值。这是可能的吗？
如果是这样，我也有同样的事情在列CY
更好的解释：
循环通过列BY
从单元格2-151的内部循环。
如果B2> Z2，还有下一个4个顺序单元格（B3-B6）> Z2，则将A2复制到B153并移至下一列。
如果B2> Z2但是下一个4不是全部> Z2，则用B3重复进程。
如果B2< Z2，移动到B3。
如果没有是真的复制N / A到B153
可以这样做？
我的第一次尝试：
= INDEX（$ A $ 2 ：$ A $ 151，SUMPRODUCT（MATCH（1， - （B $ 2：B $ 151> $ Z $ 2），0）），1）
这是第一个值。我试图想到一个聪明的方式来取得第一个价值只有当第二个价值也符合标准。从那里我相信我可以扩展到第3，第4，第5等。
这样的东西：
Sub OutputEnergy（）
'y =要检查的列：2-25
'x =要检查的行： 2-152
'z =检查下一个4个单元格
Dim x，y，z，check
'清除我们存储＃N / A或能量输出的范围
范围（B153：Y153）= vbNullString
对于y = 2到25
对于x = 2到152
如果Cells（x，y）>范围（Z2）然后'如果值大于Z2
check = True'让我们检查下一个4
对于z = 1到4'如果其中任何一个失败
如果Cells x + z，y）范围（Z2）然后
check = False'检查失败
退出对于
结束如果
下一个z
如果check = True那么'如果检查没有't fail
单元格（153，y）=单元格（x，1）'将单元格153设置为能量级别
退出
如果
结束If
Next x'如果没有设置能量级别 - ＃N / A
如果Cells（153，y）= vbNullString Then Cells（153，y）=＃N / A
Next y
End Sub
编辑：作为一个功能：
功能用法：
= OutputEnergy（范围，阈值，[要检查的单元格数]使用标题？]）
基本上，给它检查的范围，给它一个阈值。
默认情况下，要检查的单元格数为4。
要获得能量它g ets行号（如果使用标题，它减1）
函数OutputEnergy（TheRange As Range，Threshold As Variant，Optional NextCells As Integer = 4，可选OffsetForHeader As Boolean = True）As Variant
Dim c，x，check
For Each c In TheRange
如果c.Value>阈值然后
check = True
对于x = 1 To NextCells
如果c.Offset（x，0）阈值然后
check = False
退出
结束如果
下一个x
如果check = True然后
OutputEnergy = IIf（OffsetForHeader，c.Row - 1，c.Row）
退出函数
End If
End If
Next c
OutputEnergy = CVErr（xlErrNA）
结束函数
再次编辑 - 输出到所有工作表：
OutputEnergyToSheet接受表格作为参数：
Sub OutputEnergyToSheet（TheSheet As String）
' y =要检查的列：2-25
'x =要检查的行：2-152
'z =检查下一个4个单元格
Dim x，y，z，check
'清除我们存储＃N / A或能量输出
的范围与纸张（TheSheet）
.Range（B153：Y153）= vbNullString
对于y = 2至25
对于x = 2到152
如果.Cells（x，y）> .Range（Z2）然后'如果值大于Z2
check = True'让我们检查下一个4
对于z = 1到5'如果其中任何一个失败
如果。细胞（x + z，y） .Range（Z2）然后
check = False'检查失败
退出
结束如果
下一个z
如果check = True然后'如果检查不要失败
.Cells（153，y）= Int（.Cells（x，1））'将单元格153设置为能量级别
退出
如果
结束如果
下一个x'如果没有设置能量级别 - ＃N / A
如果.Cells（153，y）= vbNullString然后.Cells（153，y）=＃N / A
下一个y
结束
End Sub
OutputEnergyToAllSheets循环遍历表单并调用新的子：
Sub OutputEnergyToAllSheets（）
Dim w
对于每个w在ThisWorkbook .Worksheets
如果不是InStr（w.Name，Total）> 0而不是InStr（w.Name，eV）> 0然后
OutputEnergyToSheet w.Name
结束如果
下一个w
结束Sub
I have a column A and a column B. In column A, I have (starting in A2) values that go from 1-150 (so ending in A151)
In column B, I have values. I want to get the first value that is above the value in cell Z2 and write out the corresponing value in the A column in cell B153 for column B. Last part is tricky. I only want to write this value if the following 4 values are also above the value in Z2. Is this possible to d?
If this is, I also have the same thing in columns C-Y
Better explanation:
I want to loop through columns B-Y Inner loop from cells 2-151.
If B2>Z2 but also next 4 sequential cells (B3-B6)>Z2, then copy A2 to B153 and move to next column. If B2 > Z2 but next 4 are not all > Z2, repeat process with B3. If B2 < Z2, move to B3.
If none is true copy N/A to B153
Can this be done?
My first attempt:
=INDEX($A$2:$A$151,SUMPRODUCT(MATCH(1,--(B$2:B$151>$Z$2),0)),1)
This takes the first value though. I'm trying to think of a clever way to take the first value only if the second value also meets criteria. From there I'm sure I can expand to 3rd, 4th, 5th, etc.
Something like this:
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
Edit: As a function:
Function Usage:
=OutputEnergy(Range, Threshold, [Number of cells to check], [Using Headers?])
Basically, give it the range to check, give it a threshold.
The number of cells to check afterwards is 4 by default.
To get the "Energy" it gets the row number (If using headers, it subtracts 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
Edit again - to output to all sheets:
OutputEnergyToSheet accepts a sheet as a parameter:
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 loops through each sheet and calls the new sub:
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
这篇关于使用VBA获取阈值的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
