Question

此代码的目的是更新单元格中的日期，因为某个单元格的内容已更改。

由于这最初是在sub中编码的，我现在需要将此代码扩展到一系列多个单元格。 IE浏览器。此时，代码只占用单元格D4并更新单元格L4，我希望能够将此函数向下拖动，以便它可以达到多个单元格范围;拿D5并更新L5等。

这里的代码是sub：

Dim oldValue

Public Sub Worksheet_SelectionChange(ByVal Target As Range)
oldValue = Target.Worksheet.Range("D4").Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range) 
  If Not Intersect(Target, Target.Worksheet.Range("D4")) Is Nothing Then
    If oldValue <> Target.Worksheet.Range("D4").Value Then
        Target.Worksheet.Range("L4").Value = Date
    End If
  End If
End Sub

这里的问题是，我不知道如何正确扩展我的代码以匹配其他选择的单元格。这是我的尝试：

Dim oldValue

Public Sub Worksheet_SelectionChange(ByVal Target As Range)
oldValue = Target.Worksheet.Range("D4", "D21").Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("D4", "D21")) Is Nothing Then
    If oldValue <> Target.Worksheet.Range("D4", "D21").Value Then
        Target.Worksheet.Range("L4", "L21").Value = Date
    End If
End If
End Sub

编辑：我写的子只适用于一个单元格，我试图找到一种方法将它扩展到某个选定的单元格。 IE浏览器。 D4：D12相应更新L4：L12中的日期。

如果有人可以帮助我，那将非常感激。

Answer 1

请尝试以下代码：

Dim oldValue()

Public Sub Worksheet_SelectionChange(ByVal Target As Range)
    oldValue = Me.Range("D4:D12").Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("D4:D12")) Is Nothing Then
        Application.EnableEvents = False
        Dim c As Range
        For Each c In Intersect(Target, Me.Range("D4:D12"))
            'Check value against what is stored in "oldValue" (row 4 is in position 1, row 5 in position 2, etc)
            If oldValue(c.Row - 3, 1) <> c.Value Then
                'Update value in column L (8 columns to the right of column D)
                c.Offset(0, 8).Value = Date 'or possibly "= Now()" if you need the time of day that the cell was updated
            End If
        Next
        Application.EnableEvents = True
    End If
End Sub

Answer 2

设置隐藏工作表以保存旧值。

Sub SetupMirrorValues()
    With Worksheets.Add
        .Name = "MirrorValues"
        .visibilty = xlSheetVeryHidden
        .Range("D4:D10,D12,D14:D20") = Worksheets("Sheet1").Range("D4:D10,D12,D14:D20")
    End With
End Sub

在Worksheet_Change事件处理程序中，您将检查与要监视的范围相交的Target单元格。如果存在差异，则更新隐藏工作表上与更改的单元格对应的时间戳和单元格。

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Dim cell As Range, DRange As Range
    Set DRange = Range("D4:D10,D12,D14:D20")
    If Not Intersect(DRange, Target) Is Nothing Then
        For Each cell In Intersect(DRange, Target)

            If cell.Value <> Worksheets("MirrorValues").Range(cell.Address) Then
                cell.EntireRow.Cells(1, "L").Value = Now
                Worksheets("MirrorValues").Range(cell.Address) = cell.Value
            End If

        Next
    End If

    Application.EnableEvents = True
    Application.ScreenUpdating = False

End Sub

如何将子扩展到多个单元格范围？

2 个答案: