0

最近 VBA 已停止工作。B通常,当您在column 中输入数据时,它会自动将今天的日期填充到 column 中C,并且R当您在 column 中输入数据时,它还会将今天的日期填充到 column 中K

我最近搞砸了保护床单,最后放弃了,我觉得这与它有关。

这很奇怪,因为 VBA 的其他区域仍然有效。

如何解决这个问题,以便 VBA 仍然自动填充它需要的列?

        With Target
            If .Count > 1 Then Exit Sub
            If Not Intersect(Range("C:C"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                    .Offset(0, -1).ClearContents
                Else
                    With .Offset(0, -1)
                        .NumberFormat = "dd mmm yy"
                        .Value = Date
                    End With
                End If
                Application.EnableEvents = True
            End If
        End With
        With Target
            If .Count > 1 Then Exit Sub
            If Not Intersect(Range("K:K"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                    .Offset(0, 7).ClearContents
                Else
                    With .Offset(0, 7)
                        .NumberFormat = "dd mmm yy"
                        .Value = Date
                    End With
                End If
                Application.EnableEvents = True
            End If
        End With
    
    Const sCell As String = "K2" ' Source First Cell
    Const dCol As Variant = "J" ' Destination Column Id (String or Index)
    
    Dim irg As Range ' Intersect Range
    Dim cOffset As Long ' Column Offset
    With Range(sCell)
        Set irg = Intersect(.Resize(.Worksheet.Rows.Count - .Row + 1), Target)
        If irg Is Nothing Then Exit Sub
        cOffset = Columns(dCol).Column - .Column
    End With
    
    Dim arg As Range ' Current Area of Intersect Range
    Dim cel As Range ' Current Cell in Current Area of Intersect Range
    For Each arg In irg.Areas
        For Each cel In arg.Cells
            If Not IsError(cel.Value) Then
                cel.Offset(, cOffset).Value = cel.Value
            End If
        Next cel
    Next arg
    
End Sub```
4

1 回答 1

1

使用错误处理程序确保事件不会被关闭的示例:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim c As Range

    If Target.Cells.CountLarge > 1 Then Exit Sub
    
    If Target.Column = 3 Then
        Set c = Target.Offset(0, -1)
    ElseIf Target.Column = 11 Then
        Set c = Target.Offset(0, 7)
    End If
    
    On Error GoTo haveError 'turn on error handling
    
    If Not c Is Nothing Then 'col 3 or 11...
        Application.EnableEvents = False
        If Len(Target.Value) = 0 Then
            c.ClearContents
        Else
            c.NumberFormat = "dd mmm yy"
            c.Value = Date
        End If
        Application.EnableEvents = True
    End If
    
    Exit Sub 'normal exit here
    
haveError:
    MsgBox "Got an error: " & Err.Description
    Application.EnableEvents = True 'makes sure events are not left off
      
End Sub
于 2021-04-06T23:52:04.927 回答