如何停止代码覆盖其中包含值的单元格

时间:2019-05-05 21:46:24

标签: excel vba

我正在尝试调整以下代码,当您更改A列时,该代码将在B列中输入今天的日期。我只想在B列为空时运行此代码,因为我遇到了worksheet_change也是这样的问题如果无意中进行了新的更改,则输入的广泛日期和过去日期将被覆盖。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("A:A"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetColumn).Value = Date
            Rng.Offset(0, xOffsetColumn).NumberFormat = "mm-dd-yyyy"
        Else
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If

End Sub

1 个答案:

答案 0 :(得分:0)

您可以检查值是否已经是日期

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("A:A"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            With Rng.Offset(0, xOffsetColumn)
                If Not VBA.Information.IsDate(.Value) Then
                    .Value = Date
                    .NumberFormat = "mm-dd-yyyy"
                End If
            End With
        Else
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If

End Sub