问与答73： 如何实现录入后自动更新数据？

Q：我有两个工作表，分别是“表1”和“表2”，如下图1和图2所示。每天我打开工作簿后，在“表1”中的单元格C2中录入数据，这个数据会自动更新到“表2”与对应的日期相应的单元格中，其中“表1”中单元格A2我设置了公式=TODAY()，以便每天打开工作簿时，自动更新日期。

图1

图2

A：我们利用工作表的Change事件来实现数据的自动更新。在工作表“表1”的代码模块中，输入下列代码：

Private Sub Worksheet_Change(ByVal Target As Range)

'声明变量

Dim lngCurRow As Long

Dim lngLastRow As Long

Dim wksData As Worksheet

Dim rng As Range

'赋值工作表变量

Set wksData= Worksheets("表2")

'当前单元格所在的行号

lngCurRow =Target.Row

'工作表wksData中最后一行数据的行号

lngLastRow= wksData.Range("A" & Rows.Count).End(xlUp).Row

'更新数据

If Range("A" & lngCurRow)<> "" And _

Range("B" & lngCurRow) <> "" And _

Range("C" & lngCurRow) <> "" Then

'在工作表wksData的列A中查找

'当前单元格所在行列A单元格中的值

Set rng= wksData. _

Range("A2:A" & lngLastRow). _

Find(What:=Range("A" &lngCurRow).Value)

'如果找到

If Not rng Is Nothing Then

'将当前单元格所在行列C单元格中的值

'复制到工作表wksData中相应的单元格

Range("C" & lngCurRow).Copy _

wksData.Range("C" & rng.Row)

'清除列C中单元格的内容

Range("C" & lngCurRow).ClearContents

'如果要删除已经输入完数据的行则添加下面的语句

'Range("A" &lngCurRow).EntireRow.Delete

End If

End If

End Sub

此时，再在工作表“表1”中输入数据，其结果如下图3所示。

图3