Как я могу получить MessageBox для диапазона, который я хочу?

Question

Sub TestResult()
    Dim Score As Integer, Result As String
    Score = Range("A1:A5").Value

    If Score >= 60 Then
        Result = "pass"
    Else
        Result = "fail"
    End If
Range("B1:B5").Value = Result
End Sub

Score = Range("A1:A5").Value Эта часть является проблемой.Как мне изменить его на работу?

Answer 1

With ActiveSheet.Range("A1:A5")
    .Offset(0, 1).Value = .Parent.Evaluate("=IF(" & .Address() & ">60,""Pass"",""Fail"")")
End With

Answer 2

Метод формул

Прежде всего вы можете сделать это с формулой в диапазоне B1: B5:

=IF(A:A>=60,"pass","fail")

или вы можете написать эту формулу с помощью VBA

Range("B1:B5").Formula = "=IF(A:A>=60,""pass"",""fail"")"

Преимущество forumlas в том, что они обновляются автоматически каждый раз, когда меняются оценки.Если вы сделаете это с VBA (не используя формулу), результат будет не обновляться автоматически.

---

Метод VBA

Если вы все еще хотите сделать это сVBA вам нужно пройтись по вашим данным и проверить каждый счет.Выполнение этого с массивом, вероятно, самый быстрый способ с VBA.

Option Explicit

Public Sub TestResult()
    Dim ScoresArr As Variant 'read values into an array
    ScoresArr = Worksheets("Sheet1").Range("A1:A5").Value

    Dim ResultArr As Variant 'create result array with same size
    ReDim ResultArr(1 To UBound(ScoresArr, 1), 1 To UBound(ScoresArr, 2))

    Dim iRow As Long
    For iRow = 1 To UBound(ScoresArr, 1) 'loop through array
        If ScoresArr(iRow, 1) >= 60 Then 'test each score
            ResultArr(iRow, 1) = "pass"
        Else
            ResultArr(iRow, 1) = "fail"
        End If
    Next iRow

    Worksheets("Sheet1").Range("B1:B5").Value = ResultArr 'write results array back to cells
End Sub

Если вы хотите, чтобы пользователь мог выбрать диапазон оценок, используйте Application.InputBox с Type:=8, как показанониже:

Option Explicit

Public Sub TestResult()
    Dim ScoresRange As Variant
    On Error GoTo CANCEL_TEST 'the next line will throw an error if cancel is pressed
    Set ScoresRange = Application.InputBox(Prompt:="Select the scores", Title:="Test Result", Type:=8)
    On Error GoTo 0 'always re-activate error reporting!!!

    If ScoresRange.Columns.Count <> 1 Then 'test if only one column was selected
        MsgBox "Only selection of one column is allowed."
        Exit Sub
    End If

    Dim ScoresArr As Variant 'read values into an array
    ScoresArr = ScoresRange.Value

    Dim ResultArr As Variant 'create result array with same size
    ReDim ResultArr(1 To UBound(ScoresArr, 1), 1 To UBound(ScoresArr, 2))

    Dim iRow As Long
    For iRow = 1 To UBound(ScoresArr, 1) 'loop through array
        If ScoresArr(iRow, 1) >= 60 Then 'test each score
            ResultArr(iRow, 1) = "pass"
        Else
            ResultArr(iRow, 1) = "fail"
        End If
    Next iRow

    ScoresRange.Offset(ColumnOffset:=1).Value = ResultArr 'write results array back to cells
CANCEL_TEST:
End Sub

Answer 3

Для этого ответа я использую Sheet1.Если я правильно понял, вы хотите поставить рядом с каждым результатом, если он пройден или не пройден?

Попробуйте:

    Option Explicit

Sub TestResult()

    Dim ScoreList As Range, Score As Range, Result As String

    With ThisWorkbook.Worksheets("Sheet1")

        Set ScoreList = .Range("A1:A5")

        For Each Score In ScoreList

            If Score.Value >= 60 Then
                Score.Offset(0, 1).Value = "Pass"
            Else
                Score.Offset(0, 1).Value = "Fail"
            End If

        Next

    End With

End Sub