Question

我遇到自动约会细胞的问题。如果仅在1个单元格上按下输入，则下面的代码工作正常。我想要做的是自动约会粘贴到单元格中的行数（可以是任何数字）。

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("A2:A100001")) Is Nothing Then
            With Target(1, 2)
                .Value = Date
                .EntireColumn.AutoFit
            End With
        End If
End Sub

同样，对此的任何帮助都将非常感激。

Answer 1

我相信这会做你需要的：

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Not Intersect(Target, Range("A2:A100001")) Is Nothing Then
        'iterate through all cells in Target range
        For Each cell In Target.Cells
            cell.Offset(0, 1).Value = Date
        Next cell
        Target.Columns.Offset(0, 1).AutoFit
    End If
End Sub

这将迭代目标范围内的所有单元格（刚刚使用粘贴更改的所有单元格）并将日期添加到下一列。我们使用.offset（0,1）确定下一列。完成迭代后，我们在下一列调用.autofit。

Answer 2

尝试一下：

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim rng As Range, r As Range
    Set rng = Intersect(Target, Range("A2:A100001"))
    If rng Is Nothing Then Exit Sub
    Application.EnableEvents = False
    For Each r In rng
        With r(1, 2)
            .Value = Date
            .EntireColumn.AutoFit
        End With
    Next r
    Application.EnableEvents = True
End Sub

自动日期粘贴的单元格

2 个答案: