循环检查单元格值是否满足条件

Question

原谅新手loop SO上发了这么多次的问题，我好像想不通应该是什么简单的逻辑。下面概述了我要完成的步骤：

遍历 AllScores 范围内的所有单元格
看看Left(wsRR.Range("H32"),1)是"P"还是"G"
如果 AllScores 范围内的任何单元格的值介于 1 和 4 之间并且上面的 #2 为真，则 Label143 和 RR_Score = "Acceptable 06"

如果所有单元格的值都在 AllScores >= 5 范围内，则 Label143 的标题和 RR_Score = 范围 wsRR 的值。("H32") 或如果 Range AllScores 中每个单元格中的所有值都是 >= 5 并且上面的 #2 是真或假，那么 Labels RR_Score 和 Label143 = wsRR.("H32").[=13= 的标题]

    Sub ScoringUpdateAmounts()
Dim aScores As Range
Dim a As Integer
Dim i As Long

Set wb = Application.ThisWorkbook
Set wsRR = wb.Sheets("RiskRating")
Set wspGen = wb.Sheets("pGeneralInfo")
Set aScores = wsRR.Range("AllScores")

For i = 1 To 4
    For Each cell In aScores
        If cell.Value = i Then a = 0
    Next cell
Next i

For i = 5 To 8
    For Each cell In aScores
        If cell.Value = i Then a = 1
    Next cell
Next i

Select Case Left(wsRR.Range("H32"), 4)
    Case Is = "GOOD"
        If a = 0 Then
            RiskCalc.RR_Score.Caption = UCase("acceptable 06")
            RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
            wspGen.Range("genRR") = UCase("acceptable 06")
            wspGen.Range("genJHARiskRating") = UCase("acceptable 06")
        End If
        If 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 Select

Select Case Left(wsRR.Range("H32"), 5)
    Case Is = "PRIME"
        If a = 0 Then
            RiskCalc.RR_Score.Caption = UCase("acceptable 06")
            RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
            wspGen.Range("genRR") = UCase("acceptable 06")
            wspGen.Range("genJHARiskRating") = UCase("acceptable 06")
        End If
        If 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 Select

结束子

Answer 1

我怀疑这是否能解决您的问题，但对于发表评论来说太长了。

我按照目前的情况重新构建了您的代码，并删除了 redundant/unneeded 行。您的 1-8 循环中发生了一些奇怪的事情。您可能需要退后一步，重新思考这里的逻辑。

如果您只想知道范围内的值是否低于某个阈值，您可以使用 Min 函数来执行此操作并像这样放弃循环

If Application.WorksheetFunction.Min(aScores) <= 4 Then
    a = 0
Else
    a = 1
End If

无论哪种方式，更容易read/follow代码往往会使调试逻辑错误非常非常更容易

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 Sub

Answer 2

这是我能得到的最接近的结果，因为我很确定我没有遵循你的所有逻辑：

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

Answer 3

我喜欢不循环遍历范围而只使用 Min 函数的解决方案，我也喜欢@TimWilliams 使用 rating 变量的方式，所以我将这两个单独的解决方案结合起来并进行了一些编辑标签的格式，它完美地工作。下面是我最终使用的代码。感谢你们的耐心和帮助这个新手。抱歉，我无法检查您作为解决方案提供的两个答案。

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 Sub

循环检查单元格值是否满足条件

Loop to check if a cell value meets a condtion

vba

excel-2013