应用程序定义或对象定义的错误（EXCEL VBA）

Question

我不断收到一个错误1004这条线在我的VBA宏编辑器：

If ActiveCell.Name.Name = "DayShift" Or ActiveCell.Name.Name = "AfterShift" Then 

有谁知道为什么吗？这是我的整个宏：

Private Sub Worksheet_Change(ByVal Target As Range) 

Dim col As Integer 
col = ActiveCell.Column 
Dim bValue As String 
Dim cValue As String 

'Check if cell is required to have both columns with value. 
    'If it is, skip checks. 
    If ActiveCell.Name.Name = "DayShift" Or ActiveCell.Name.Name = "AfterShift" Then 

     End 

    End If 

'Check if active column is column B. 
If ColLetter(col) = "B" Then 

    'Format value of active cell. 
    cValue = "C" + Str(ActiveCell.Row) 
    cValue = Replace(cValue, " ", "") 

    'Check if cell has value. 
    If Range(cValue) = vbNullString Then 

    'If it does, remove the opposite shift. 
    Else 
     MsgBox "This employee has already been assigned for the afternoon shift. In order to allow this change, this employee's scheduling for the afternoon shift will be removed.", vbExclamation 
     Range(cValue).ClearContents 
    End If 

'Check if active column is column C. 
ElseIf ColLetter(col) = "C" Then 

    'Format value of active cell. 
    bValue = "B" + Str(ActiveCell.Row) 
    bValue = Replace(bValue, " ", "") 

    'Check if cell has value. 
    If Range(bValue) = vbNullString Then 

    'If it does, remove the opposite shift. 
    Else 
     MsgBox "This employee has already been assigned for the day shift. In order to allow this change, this employee's scheduling for the day shift will be removed.", vbExclamation 
     Range(bValue).ClearContents 
    End If 

End If 
End Sub 

Function ColLetter(ColNumber As Integer) As String 
    ColLetter = Left(Cells(1, ColNumber).Address(False, False), _ 
     1 - (ColNumber > 26)) 
End Function 

Answer 1

您必须检查名称与错误处理上。请参阅下面的代码。我也投入了其他一些改变。

Private Sub Worksheet_Change(ByVal Target As Range) 

    Dim bValue As String 
    Dim cValue As String 
    Dim bIsDayShift As Boolean, bIsAfterShift As Boolean 
    Dim sMsg As String 

    Application.EnableEvents = FALSE 

    sMsg = "This employee has already been assigned for the replaceme shift. " 
    sMsg = sMsg & "In order to allow this change, this employee's scheduling " 
    sMsg = sMsg & "for the replaceme shift will be removed." 

    'Check if cell is required to have both columns with value. 
    'If it is, skip checks. 
    On Error Resume Next 
     bIsDayShift = Target.Name.Name = "DayShift" 
     bIsAfterShift = Target.Name.Name = "AfterShift" 
    On Error GoTo 0 

    If Not bIsDayShift And Not bIsAfterShift Then 
     'Check if active column is column B. 
     If Target.Column = 2 Then 
      If Not IsEmpty(Target.Offset(0, 1).Value) Then 
       MsgBox Replace(sMsg, "replaceme", "afternoon"), vbExclamation 
       Target.Offset(0, 1).ClearContents 
      End If 

     'Check if active column is column C. 
     ElseIf Target.Column = 3 Then 
      If Not IsEmpty(Target.Offset(0, -1).Value) Then 
       MsgBox Replace(sMsg, "replaceme", "day"), vbExclamation 
       Target.Offset(0, -1).ClearContents 
      End If 

     End If 
    End If 

    Application.EnableEvents = TRUE 

End Sub