Excel VBA将（不变）时间戳添加到命名单元格

Question

我想自动将非更新时间戳添加到 NAMED CELLS (Named_Cell_1, Named_Cell_2,...) 或特定的 NAMED RANGE 单元格(Named_Range_Cells_1, Named_Range_Cells_2,. ..) 随机放置在工作表中，当在命名单元格或命名范围的直接相邻列中的直接相邻单元格中输入值时。

我不能使用未命名的单元格或单元格范围（例如：A1:A4）来确定需要输入日期戳的单元格，因为这些单元格是动态工作表的一部分，行和列不断变化，因此，需要出现日期戳的单元格必须全部命名为单元格或范围。

大约有 5 到 6 个命名单元格需要加盖日期，所以我不介意对每个单元格进行硬 VBA 编码。

我意识到我们需要 VBA 代码来解决这个问题，而且我们不能使用 Now() 或 Today()。

您的帮助和时间将不胜感激。我发现一些代码 sn-ps 可以完成这项工作，但过于笼统，不使用单元格名称或范围名称。

非常感谢任何帮助。

= = = = = = = = =

这是第一个sn-p。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 3 Then
        Application.EnableEvents = False
        Cells(Target.Row, 4) = Date + Time
        Application.EnableEvents = True
    End If
End Sub

等一下。

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
    With Target(1, 2)
    .Value = Date
    .Entire Column.AutoFit
    End With
End If
End Sub

Answer 1

一种方法：在Worksheet_Change 中测试相邻单元格是否有名称，如果它确实测试名称的名称以查看它是否是“此处的时间戳”名称。然后放置时间戳。

明确地说，是包含被命名的时间戳的单元格。

像这样，将时间戳放在更改数据的左侧

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cl As Range, nm As Name

    For Each cl In Target.Cells
        If cl.Column > 1 Then
            Set nm = Nothing
            On Error Resume Next
            Set nm = cl.Offset(0, -1).Name
            On Error GoTo 0
            If Not nm Is Nothing Then
                ' Keep only one of these three lines
                If nm.Name Like "*Named_Cell_*" Then ' Book or Sheet scoped names
                'If nm.Name Like "Named_Cell_*" Then ' Book scoped names
                'If nm.Name Like "*!Named_Cell_*" Then ' Sheet scoped names

                    Application.EnableEvents = False
                    nm.RefersToRange = Date + Time
                    Application.EnableEvents = True
                End If
            End If
        End If
    Next
End Sub

像这样，将时间戳放在更改数据的右侧

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cl As Range, nm As Name

    For Each cl In Target.Cells
        If cl.Column < Me.Columns.Count  Then
            Set nm = Nothing
            On Error Resume Next
            Set nm = cl.Offset(0, 1).Name
            On Error GoTo 0
            If Not nm Is Nothing Then
                ' Keep only one of these three lines
                If nm.Name Like "*Named_Cell_*" Then ' Book or Sheet scoped names
                'If nm.Name Like "Named_Cell_*" Then ' Book scoped names
                'If nm.Name Like "*!Named_Cell_*" Then ' Sheet scoped names

                    Application.EnableEvents = False
                    nm.RefersToRange = Date + Time
                    Application.EnableEvents = True
                End If
            End If
        End If
    Next
End Sub

这处理 WorkBook 和 WorkSheet 范围的名称。其他选项包括在注释掉的行中

确保名称模式对于这些“时间戳在此处”名称是唯一的。

您可以拥有任意数量的命名单元，只需在名称中添加后缀即可。我个人会使用工作表范围的名称“TimeStampGoesHere_1”、“TimeStampGoesHere_2”等（您可以在每张纸上重新编号为 1）并更改为 If 以

If nm.Name Like "*!TimeStampGoesHere_*" Then

关于名称范围的说明。

名称的范围可以是工作簿或单个工作表。这在名称管理器中可见。从If 语句的工作原理中应该可以清楚地看到

要查看 VBA 如何报告这些命名范围的名称，请运行此

Sub NameScope()
    Dim nm As Name

    Set nm = Sheet1.Range("A1").Name
    Debug.Print "Workbook Scoped Name", nm.Name

    Set nm = Sheet1.Range("A2").Name
    Debug.Print "Worksheet Scoped Name", nm.Name
End Sub

显示

工作簿范围名称示例 1
工作表范围名称 Sheet1!Sample2