如果范围为空，VBA清除单元格的内容

Question

除了缺陷之外，我的代码运行良好。它检查范围中的文本并返回相邻单元格中的文本。如果相邻范围行（ C列到G ）为空，我希望它返回一个空白单元格（ B列）。这是下面的代码

Sub status_summary()
    Dim r As Integer
    Dim fail As Boolean
    Dim mrit As Boolean
    Dim pass As Boolean

    For r = 2 To 6
        If Range("C" & r) = "Failed" Then fail = True
        If Range("C" & r) = "Merit" Then mrit = True
        If Range("C" & r) = "Pass" Then pass = True

        If Range("D" & r) = "Failed" Then fail = True
        If Range("D" & r) = "Merit" Then mrit = True
        If Range("D" & r) = "Pass" Then pass = True

        If Range("E" & r) = "Failed" Then fail = True
        If Range("E" & r) = "Merit" Then mrit = True
        If Range("E" & r) = "Pass" Then pass = True

        If Range("F" & r) = "Failed" Then fail = True
        If Range("F" & r) = "Merit" Then mrit = True
        If Range("F" & r) = "Pass" Then pass = True

        If Range("G" & r) = "Failed" Then fail = True
        If Range("G" & r) = "Merit" Then mrit = True
        If Range("G" & r) = "Pass" Then pass = True

        If pass = True Then Range("B" & r) = "Pass"
        If mrit = True Then Range("B" & r) = "Merit"
        If fail = True Then Range("B" & r) = "Failed"

        fail = False
        mrit = False
        pass = False

    Next r

    MsgBox ("All Done")
End Sub

Answer 1

你不需要这么大的代码或VBA：）

非VBA方法

使用公式

这在Cell B2中。只需将其复制下来。

=IF(COUNTA(C2:G2)=0,"",IF(COUNTIF(C2:G2,"Failed")>0,"Failed",IF(COUNTIF(C2:G2,"Merit")>0,"Merit",IF(COUNTIF(C2:G2,"Pass")>0,"Pass",""))))

但是如果您仍然想要VBA，请参阅下面的内容。

VBA方法

A）缩短代码

Sub status_summary()
    Dim r As Integer

    For r = 2 To 6
        If Application.WorksheetFunction.CountA(Range("C" & r & ":G" & r)) = 0 Then
            Range("B" & r) = ""
        ElseIf Application.WorksheetFunction.CountIf(Range("C" & r & ":G" & r), "Failed") > 0 Then
            Range("B" & r) = "Failed"
        ElseIf Application.WorksheetFunction.CountIf(Range("C" & r & ":G" & r), "Merit") > 0 Then
            Range("B" & r) = "Merit"
        ElseIf Application.WorksheetFunction.CountIf(Range("C" & r & ":G" & r), "Pass") > 0 Then
            Range("B" & r) = "Pass"
        End If
    Next r

    MsgBox ("All Done")
End Sub

B）在VBA中使用公式

Sub status_summary()
    Range("B2:B6").Formula = "=IF(COUNTA(C2:G2)=0,"""",IF(COUNTIF(C2:G2,""Failed"")>0,""Failed"",IF(COUNTIF(C2:G2,""Merit"")>0,""Merit"",IF(COUNTIF(C2:G2,""Pass"")>0,""Pass"",""""))))"

    MsgBox ("All Done")
End Sub