Цикл, чтобы проверить, соответствует ли значение ячейки условию - PullRequest
Новая
       12

Цикл, чтобы проверить, соответствует ли значение ячейки условию

0 голосов
/ 21 ноября 2018

Простите новичка loop вопрос, который был так много раз опубликован на SO, но я не могу понять, что должно быть простой логикой.Ниже описаны шаги, которые я пытаюсь выполнить:

  1. Цикл всех ячеек в диапазоне AllScores
  2. Посмотрите, является ли Left(wsRR.Range("H32"),1) "P" или "G"
  3. Если какая-либо из ячеек в диапазоне AllScores имеет значение от 1 до 4 и № 2, приведенное выше, имеет значение true, тогда заголовки Label143 и RR_Score = "Приемлемо 06"

  4. Если всезначений ячеек в диапазоне AllScores> = 5, тогда заголовки Label143 и RR_Score = значения диапазона wsRR. ("H32") или если все значения в каждой ячейке в диапазоне 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

    End Sub

Ответы [ 3 ]

0 голосов
/ 21 ноября 2018

Это как можно ближе, так как я почти уверен, что не следую всей вашей логике: 

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
0 голосов
/ 21 ноября 2018

Мне понравилось решение не зацикливаться на диапазоне и просто использовать функцию 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 Sub
0 голосов
/ 21 ноября 2018

Я сомневаюсь, что это решит вашу проблему, но это слишком долго для комментария.

Я реструктурировал ваш код в том виде, в каком он сейчас есть, и удалил лишние / ненужные строки.В вашем цикле 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Похожие темы

...