如果范围为空，则清除单元格内容的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使用公式

这正好细胞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