如何获得所需范围的 MessageBox？答案

【问题标题】：How can I get the MessageBox for the Range I want?如何获得所需范围的 MessageBox？
【发布时间】：2019-05-02 02:16:04
【问题描述】：

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这部分是问题所在。我应该如何改变它才能工作？

【问题讨论】：

您能澄清一下预期的行为是什么，什么是行不通的吗？

标签： excel vba

【解决方案1】：

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

【讨论】：

【解决方案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

【讨论】：

【解决方案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

【讨论】：