循环，以检查单元格值是否符合condtion。
循环，以检查单元格值是否符合condtion。
提问于 2018-11-20 22:22:34
请原谅新手loop的问题，这个问题已经贴了这么多次了，但我似乎不知道什么应该是简单的逻辑。以下是我正在努力完成的任务的步骤：
- 循环遍历范围内的所有单元格AllScores
- 看看
Left(wsRR.Range("H32"),1)是"P“还是"G” - 如果AllScores范围内的任何单元格的值介于1到4之间，而上面的#2为真，则Label143和RR_Score =“可接受的06”的标题
- 如果range AllScores >= 5中单元格的所有值，则Label143和RR_Score = range wsRR值的标题(“H32”)或如果Range AllScores中每个单元格中的所有值为>= 5和#2，则标签RR_Score和Label143 =wsRR(“H32”)的标题为真或假。 子ScoringUpdateAmounts() Dim aScores作为范围Dim a作为整数Dim i长集wb = Application.ThisWorkbook Set wsRR = wb.Sheets("RiskRating") Set wspGen = wb.Sheets("pGeneralInfo") Set aScores = wsRR.Range("AllScores")表示aScores中每个单元格的i=1至4，如果cell.Value =i然后a=0下一个单元格(i=5到8)，则aScores中的每个单元格的wspGen=wb.Sheets=aScores=wsRR.Range(“AllScores”)，则a=1。接下来我选择左边的案例(wsRR.Range(“H32”)，4)如果a=0，则RiskCalc.RR_Score.Caption =UCase(“可接受06") RisKRat.Label143.Caption= RiskCalc.RR_Score.Caption wspGen.Range("genRR") =UCase(”可接受06") wspGen.Range("genJHARiskRating") =UCase(“可接受06")如果a=1时结束RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32")) RisKRat.Label143.Caption=UCase(“H32”) wspGen.Range("genRR") =UCase(wsRR.Range(“H32”) wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32"))5)大小写为:如果a=0，则RiskCalc.RR_Score.Caption =UCase(“可接受06") RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption wspGen.Range("genRR") =UCase(”可接受06") wspGen.Range("genJHARiskRating") =UCase(“可接受06")如果a=1时结束RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32")) RisKRating.Label143.Caption = UCase(wsRR.Range("H32")) wspGen.Range("genRR") =UCase(wsRR.Range(“H32”) wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32")) 结束子对象
回答 3
Stack Overflow用户
回答已采纳
发布于 2018-11-21 14:53:39
我喜欢不遍历范围和只使用Min函数的解决方案，我还喜欢@TimWilliams使用评级变量的方式，因此我将这两个单独的解决方案与一些编辑组合在一起，以便对标签进行格式化，而且效果非常好。下面是我最后使用的代码。谢谢你们两位的耐心和帮助这个新手。对不起，我不能同时检查您作为解决方案提供的两个答案。
Sub LessThanFour()
Dim aScores As Range
Dim a As Long
Dim i As Long, rating, capt
Set wb = Application.ThisWorkbook
Set wsRR = wb.Sheets("RiskRating")
Set wspGen = wb.Sheets("pGeneralInfo")
Set aScores = wsRR.Range("AllScores")
If Application.WorksheetFunction.Min(aScores) <= 4 Then
a = 0
Else
a = 1
End If
rating = UCase(wsRR.Range("H32").Value)
If rating Like "GOOD*" Or rating Like "PRIME*" Then
If a = 0 Then
capt = "ACCEPTABLE 06"
Else
capt = rating
End If
End If
If Len(capt) > 0 Then
RiskCalc.RR_Score.Caption = capt
RisKRating.Label143.Caption = capt
wspGen.Range("genRR") = capt
wspGen.Range("genJHARiskRating") = capt
End If
With RiskCalc.RR_Score
.Visible = True
Select Case Right(capt, 1)
Case 1 To 3: .BackColor = vbRed
Case 4 To 5: .BackColor = vbYellow
Case 6 To 7: .BackColor = vbGreen
Case Is >= 8
.BackColor = RGB(0, 153, 255)
.ForeColor = vbWhite
End Select
.Font.Size = 20
.Font.Bold = True
.TextAlign = fmTextAlignCenter
.BorderStyle = fmBorderStyleSingle
End With
With RisKRating.Label143
.Visible = True
Select Case Right(capt, 1)
Case 1 To 3: .BackColor = vbRed
Case 4 To 5: .BackColor = vbYellow
Case 6 To 7: .BackColor = vbGreen
Case Is >= 8
.BackColor = RGB(0, 153, 255)
.ForeColor = vbWhite
End Select
.Font.Size = 16
.Font.Bold = True
.TextAlign = fmTextAlignCenter
.BorderStyle = fmBorderStyleSingle
End With
End SubStack Overflow用户
发布于 2018-11-21 02:18:40
我怀疑这会解决你的问题，但这太长了，不能发表评论。
我重新构造了您的代码，并删除了多余/不需要的行。在你的1-8循环中发生了一些奇怪的事情。你可能需要后退一步，重新思考这里的逻辑。
如果您只想知道范围的值是否低于某个阈值，可以使用Min函数这样做，并像这样丢弃循环
If Application.WorksheetFunction.Min(aScores) <= 4 Then
a = 0
Else
a = 1
End If无论哪种方式，易于阅读/跟踪代码都会使调试逻辑错误变得非常容易。
Option Explicit
Sub ScoringUpdateAmounts()
Dim wsRR As Worksheet: Set wsRR = ThisWorkbook.Sheets("RiskRating")
Dim wspGen As Worksheet: Set wspGen = ThisWorkbook.Sheets("pGeneralInfo")
Dim aScores As Range, a As Integer, MyCell As Range
Set aScores = wsRR.Range("AllScores")
For Each MyCell In aScores
Select Case MyCell
Case 1, 2, 3, 5
a = 0
Case 5, 6, 7, 8
a = 1
End Select
Next MyCell
If Left(wsRR.Range("H32"), 4) = "GOOD" Then
If a = 0 Then
RiskCalc.RR_Score.Caption = "ACCEPTABLE 06"
RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
wspGen.Range("genRR") = "ACCEPTABLE 06"
wspGen.Range("genJHARiskRating") = "ACCEPTABLE 06"
ElseIf a = 1 Then
RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32"))
RisKRating.Label143.Caption = UCase(wsRR.Range("H32"))
wspGen.Range("genRR") = UCase(wsRR.Range("H32"))
wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32"))
End If
End If
If Left(wsRR.Range("H32"), 5) Then
If a = 0 Then
RiskCalc.RR_Score.Caption = "ACCEPTABLE 06"
RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
wspGen.Range("genRR") = "ACCEPTABLE 06"
wspGen.Range("genJHARiskRating") = "ACCEPTABLE 06"
ElseIf a = 1 Then
RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32"))
RisKRating.Label143.Caption = UCase(wsRR.Range("H32"))
wspGen.Range("genRR") = UCase(wsRR.Range("H32"))
wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32"))
End If
End If
End SubStack Overflow用户
发布于 2018-11-21 07:12:21
这是我所能得到的最好的结果，因为我很确定我没有遵循你所有的逻辑：
Sub ScoringUpdateAmounts()
Dim aScores As Range, wb As Workbook, wsRR As Worksheet
Dim a As Long, wspGen As Worksheet, cell As Range
Dim i As Long, v, numL As Long, numH As Long, rating, capt
Set wb = ThisWorkbook
Set wsRR = wb.Sheets("RiskRating")
Set wspGen = wb.Sheets("pGeneralInfo")
Set aScores = wsRR.Range("AllScores")
For Each cell In aScores
v = cell.Value
If IsNumeric(v) And Len(v) > 0 Then
If v > 0 And v <= 4 Then
numL = numL + 1
ElseIf v > 4 And v <= 8 Then
numH = numH + 1
End If
End If
Next cell
rating = UCase(wsRR.Range("H32").Value)
If rating Like "GOOD*" Or rating Like "PRIME*" Then
If numL > 0 Then
capt = "ACCEPTABLE 06"
ElseIf numL = 0 And numH > 0 Then
capt = rating
End If
End If
If Len(capt) > 0 Then
RiskCalc.RR_Score.Caption = capt
RisKRating.Label143.Caption = capt
wspGen.Range("genRR") = capt
wspGen.Range("genJHARiskRating") = capt
End If
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/53402488
复制相关文章
相似问题
腾讯云开发者
Copyright © 2013 - 2026 Tencent Cloud. All Rights Reserved. 腾讯云 版权所有
深圳市腾讯计算机系统有限公司 ICP备案/许可证号：粤B2-20090059 
粤公网安备44030502008569号
腾讯云计算（北京）有限责任公司 京ICP证150476号 | 京ICP备11018762号