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

时间：2018-11-20 22:22:35

标签： vba excel-2013

原谅已经在SO上发布过很多次的loop新手问题，但是我似乎无法弄清楚什么应该是简单的逻辑。下面概述了我要完成的步骤：

  1. 遍历AllScores范围内的所有单元格
  2. 查看Left(wsRR.Range("H32"),1)是“ P”还是“ G”
  3. 如果AllScores范围内的任何单元格的值在1-4之间，并且上面的＃2为true，则Label143和RR_Score的标题=“ Acceptable 06”

  4. 如果范围AllScores> = 5中所有单元格的值，则Label143和RR_Score的标题=范围wsRR。（“ H32”）的值，或者如果Range中每个单元格中的所有值AllScores >> = 5，并且上面的＃2是true或false，则标签RR_Score和Label143的标题= wsRR。（“ H32”）。

        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

    结束子

3 个答案:

答案 0 :(得分：1)

我怀疑这是否可以解决您的问题，但是对此发表评论太久了。

我重新构建了您当前的代码结构，并删除了多余/不需要的行。 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 Sub

答案 1 :(得分：1)

由于我很确定我没有遵循您的所有逻辑，因此我已经尽可能接近了

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

答案 2 :(得分：-1)

我喜欢不循环范围而仅使用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
相关问题
最新问题