多个小区更改事件

Question

我有一个VBA脚本，可以在电子表格的某些行中输入时间时添加注释。我得到了

运行时错误13

更改多个单元格时。我使用了另一个搜索尝试解决问题的结果，但它对我不起作用。

我很擅长在Excel中使用VBA并且有点耐心。我还想对改进剧本进行建设性的批评。另外，在旁注中，与在主页选项卡上使用条件格式设置工具相比，在脚本中执行条件格式设置的优点/缺点是什么。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim comment As String
Dim time As String
Dim StartCell As String
Dim EndCell As String
StartCell = "A" & Target.Row
EndCell = "R" & Target.Row
time = Target.Value
time = Format(Target.Value, "h:mm AM/PM")
comment = Range("R" & Target.Row).Value

If Target.Cells.CountLarge > 1 Then
   Exit Sub
End If

If Target.Value <> "" Then

    Select Case Target.Column

        Case 1
            Range("Q" & Target.Row) = "Pending"
        Case 8
            If comment = "" Then
                 Range("R" & Target.Row) = time & " EST Tech on site, initial prep, SW and SO# verified"
            Else
                Range("R" & Target.Row) = time & " EST Tech on site, initial prep, SW and SO# verified" & Chr(10) & comment
            End If
            Range("Q" & Target.Row) = "In Progress"
        Case 9
            Range("R" & Target.Row) = time & " EST Installing HW" & Chr(10) & comment
        Case 10
            Range("R" & Target.Row) = time & " EST Phase 1 SW Installation" & Chr(10) & comment
        Case 11
            Range("R" & Target.Row) = time & " EST Running TPM and checking devices" & Chr(10) & comment
        Case 12
            Range("R" & Target.Row) = time & " EST Phase 2 SW Installation" & Chr(10) & comment
        Case 13
            Range("R" & Target.Row) = time & " EST Post Imaging Tasks" & Chr(10) & comment
        Case 14
            Range("R" & Target.Row) = time & " EST Upgrade Complete" & Chr(10) & comment
            Range("Q" & Target.Row) = "Complete"
        Case 17
            Select Case Target.Value
                Case ""
                    Range(StartCell, EndCell).Interior.ColorIndex = 0
                    Range(StartCell, EndCell).Font.ColorIndex = 1
                Case "Pending"
                    Range(StartCell, EndCell).Interior.ColorIndex = 0
                    Range(StartCell, EndCell).Font.ColorIndex = 1
                Case "En Route"
                    Range(StartCell, EndCell).Interior.ColorIndex = 15
                    Range(StartCell, EndCell).Font.ColorIndex = 1
                Case "In Progress"
                    Range(StartCell, EndCell).Interior.ColorIndex = 36
                    Range(StartCell, EndCell).Font.ColorIndex = 1
                Case "Complete"
                    Range(StartCell, EndCell).Interior.Color = RGB(84, 130, 53)
                    Range(StartCell, EndCell).Font.ColorIndex = 1
                Case "Cancelled"
                    Range(StartCell, EndCell).Font.ColorIndex = 3
                Case "Rescheduled"
                    Range(StartCell, EndCell).Interior.ColorIndex = 0
                    Range(StartCell, EndCell).Font.ColorIndex = 3
                Case "Carryover"
                    Range(StartCell, EndCell).Interior.Color = RGB(0, 153, 255)
                    Range(StartCell, EndCell).Font.ColorIndex = 3

              End Select

    End Select

End If

End Sub

Answer 1

移动：

If Target.Cells.CountLarge > 1 Then
   Exit Sub
End If

向上到Dims

的正下方

（可能还有其他问题）

多个小区更改事件

假设我们通过 A10 在 A1 中录制状态。如果我们在这些单元格中输入“complete”并且相邻单元格为空，则在该相邻单元格中记录当前日期。这是一次处理多个“完成”的典型方法：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, Intersection As Range, SingleCell As Range

    Set rng = Range("A1:A10")
    Set Intersection = Intersect(Target, rng)
    If Intersection Is Nothing Then Exit Sub

    Application.EnableEvents = False
        For Each SingleCell In Intersection
            With SingleCell
                If .Value = "complete" And .Offset(0, 1).Value = "" Then
                    .Offset(0, 1).Value = Date
                End If
            End With
        Next SingleCell
    Application.EnableEvents = True
End Sub

多个单元格更改时脚本抛出运行时错误13

1 个答案:

多个小区更改事件