最近 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```