我怎样才能把一个子分散到多个单元格区域？

此代码的目的是更新某个单元格的内容发生更改的单元格中的date。

由于这是最初编码在一个子，我现在需要扩大这个代码范围的多个单元格。 IE浏览器。 此时，代码只需要单元格D4并更新单元格L4，我希望能够拖动这个函数，使它可以达到多个单元格区域; 拿D5和更新L5等

这是我的代码作为子：

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 

这里的问题是，我不知道如何正确扩展我的代码来匹配更多的单元格select。 这是我的尝试：

 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 

编辑：我已经写的子只适用于一个单元格，我试图找出一种方法，以扩大到一定的select单元格。 IE浏览器。 D4：D12相应地更新L4：L12中的date。

如果有人能帮助我，那将不胜感激。

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