1

我正在处理一个工作表,当在目标单元格中​​输入值时,它将在 Excel 工作表中输入静态日期和时间。但是,工作表将用于从下载文件复制值并粘贴到宏工作表的地方。键入值时,日期和时间按预期工作,但如果粘贴值,VBA 代码不起作用,必须键入。我怎样才能做到这一点?

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub

        If Not Intersect(Target, Range("C2:C100")) Is Nothing Then

            With Target(1, -1)

                .Value = Date

                .EntireColumn.AutoFit

            End With

        End If

End Sub
4

2 回答 2

1

像这样的东西:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range, c As Range
    
    'any updates to C2:C100 ?
    Set rng = Application.Intersect(Target, Me.Range("C2:C100"))
    
    If Not rng Is Nothing Then
        'loop over all updated cells
        For Each c In rng.Cells
            c.Offset(0, -2).Value = Date
        Next c
        rng.Offset(0, -2).EntireColumn.AutoFit
    End If

End Sub
于 2021-04-16T18:48:51.663 回答
0

在单元格更改上添加日期戳

  • 选一个。

简单的

Private Sub Worksheet_Change(ByVal Target As Range)

    Const cFirst As String = "C2"
    Const dCol As String = "A"

    Dim rg As Range
    Set rg = Range(cFirst).Resize(Rows.Count - Range(cFirst).Row + 1)
    Set rg = Intersect(Target, rg)

    If Not rg Is Nothing Then
        ' Since you cannot manually paste a non-contiguous range
        ' (you can copy one), you can get away with the following line:
        rg.EntireRow.Columns(dCol).Value = Date
        rg.EntireColumn.AutoFit
    End If

End Sub

难的

Private Sub Worksheet_Change(ByVal Target As Range)

    Const cFirst As String = "C2"
    Const dCol As String = "A"

    ' Create a reference to the column range from 'cFirst'
    ' to the bottom-most cell in the worksheet.
    Dim rg As Range: Set rg = Intersect(Target, _
        Range(cFirst).Resize(Rows.Count - Range(cFirst).Row + 1))

    If rg Is Nothing Then Exit Sub

    ' If you plan to populate the cells via VBA, then you could write
    ' non-contiguously to the column range,
    ' e.g. with 'Range("C3,C5:C7,C10:20").value = 1'.
    ' Then you could use the following:
    Dim dDate As Date: dDate = Date
    Dim arg As Range
    For Each arg In rg.Areas
        arg.EntireRow.Columns(dCol).Value = dDate
    Next arg

    rg.EntireColumn.AutoFit

End Sub

艰难的

Private Sub Worksheet_Change(ByVal Target As Range)
    addDateStamp Target, "C2", "A"
End Sub

' This is usually, but not necessarily, located in a standard module.
Sub addDateStamp( _
        ByVal TargetRange As Range, _
        ByVal FirstCellAddress As String, _
        ByVal DateStampColumn As String)
    
    If Not TargetRange Is Nothing Then
        
        Dim rg As Range
        With TargetRange.Worksheet.Range(FirstCellAddress)
            Set rg = .Resize(.Worksheet.Rows.Count - .Row + 1)
        End With
        Set rg = Intersect(TargetRange, rg)
        
        If Not rg Is Nothing Then
            Dim dDate As Date: dDate = Date
            Dim arg As Range
            For Each arg In rg.Areas
                arg.EntireRow.Columns(DateStampColumn).Value = dDate
            Next arg
            rg.EntireColumn.AutoFit
        End If
    
    End If
    
End Sub
于 2021-04-17T09:40:33.043 回答