excel VBA 中 SpecialCell 基金的错误处理程序

Question

我在如何使用错误处理程序方面遇到了一些问题。请看下面的代码。基本上我想在迭代中找出每一行的空白单元格，如果找到，用黄色（44）为它们着色并在最后给出一个对话框（我添加一个整数，如果大于 1 它返回一个对话框）这是另一个问题我如何在错误处理过程中跳过这个？所以我使用 SpecialCells(xlCellTypeBlanks) 来查找空白单元格。因此，当没有空白单元格时，根据上述功能是错误的。我不确定我使用错误处理程序的正确程度。谁能在这里提供意见。

Sub checkblankcells()
Dim i, j, k, error, error1, error2, lastRow, LastCol As Long
Dim item, cntr As String
Dim r As Range
error2 = 0
lastRow = Range("D65000").End(xlUp).row
Application.ScreenUpdating = False
Sheets("Import").Activate
Dim counter As Long
For i = 1 To lastRow
    With ActiveSheet
    LastCol = .Cells(i, .Columns.Count).End(xlToLeft).Column
    End With
    Set r = Range(Cells(i, 4), Cells(i, LastCol))
    On Error GoTo Check1
    r.SpecialCells(xlCellTypeBlanks).Select
    Selection.Interior.ColorIndex = 44
    error2 = error2 + 1
    Check1:
    Resume Next
    Next
    'Deleting the Blank cell Check Numbers at the end of each row.
    lastRow = Range("D65000").End(xlUp).row
    Application.ScreenUpdating = False
    Sheets("Import").Activate
    For i = 1 To lastRow
    With ActiveSheet
    LastCol = .Cells(i, .Columns.Count).End(xlToLeft).Column
   End With
   Cells(i, LastCol).Select
   Selection.Clear
   Next
   If error2 > 0 Then
    MsgBox "Blank Activities in Yellow. Check Schedules", vbCritical, "TIL"
 Exit Sub
  End If
 End Sub

Answer 1

On Error GoTo <label> 函数的工作方式与任何 GoTo 函数一样：它只是在发生错误时将代码执行器带到另一行。有一些隐藏变量Err，只要发生错误，它就会改变值。默认情况下，它有值0，当一切正常时，以及一些特定的错误代码值，当执行代码期间发生错误时。所以，不要创建变量error2，而是这样做：

Sub checkblankcells()
Dim i, j, k, lastRow, LastCol As Long
Dim item, cntr As String
Dim r As Range
lastRow = Range("D65000").End(xlUp).Row
Application.ScreenUpdating = False
Sheets("Import").Activate
Dim counter As Long
For i = 1 To lastRow
    With ActiveSheet
        LastCol = .Cells(i, .Columns.Count).End(xlToLeft).Column
    End With
    Set r = Range(Cells(i, 4), Cells(i, LastCol))
    On Error GoTo Check1
    r.SpecialCells(xlCellTypeBlanks).Select
    Selection.Interior.ColorIndex = 44
Next i
    'Deleting the Blank cell Check Numbers at the end of each row.
    lastRow = Range("D65000").End(xlUp).Row
    Application.ScreenUpdating = False
    Sheets("Import").Activate
For i = 1 To lastRow
    With ActiveSheet
        LastCol = .Cells(i, .Columns.Count).End(xlToLeft).Column
    End With
    Cells(i, LastCol).Select
    Selection.Clear
Next i

Check1:
    If Err <> 0 Then
        MsgBox "Blank Activities in Yellow. Check Schedules", vbCritical, "TIL"
    End If
End Sub

我没有你的工作簿，我无法测试这段代码，所以我可能会忘记一些东西，即使如此，我相信你可以看到使用 Err 变量的想法。

Answer 2

我不确定我是否完全按照您所做的那样做，但这有效（我认为）！我没有包括删除空白单元格检查号，因为我不了解工作表的上下文，并且可能会删除一些重要的东西 - 你可以自己合并。这也会清除之前所有单元格的颜色，这是您可能不想要的。我不太清楚你还想要什么，所以如果需要，请告诉我。祝你好运！

Sub ColourEmpties()
        Dim myRange As Range
        Dim x As Long
        Dim y As Long

Range("A1").Select
Selection.End(xlToRight).Select
x = ActiveCell.Column

Selection.End(xlDown).Select
y = ActiveCell.Row

 On Error GoTo Done

    'clear all color
    Range(Cells(1, 1), Cells(y, x)).Interior.ColorIndex = xlNone

    'color only blank cells
    Range(Cells(1, 1), Cells(y, x)).SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 44

     MsgBox "Blank Activities in Yellow. Check Schedules"

Done:

End Sub