'强制声明
Option Explicit
'单元格更改时触发事件
Private Sub Worksheet_Change(ByVal Target As Range)
'如果活动单元格大于1时停止程序
If Target.Count > 1 Then Exit Sub
'使用Intersect方法判断所选单元格
If Intersect([b2].CurrentRegion, Target) Is Nothing Then Exit Sub
'声明变量
Dim yf$, r1, rq, c%, ad$
'将B2单元格的值赋值给变量yf
yf = [b2].Value
'将活动单元格的位置赋值给变量ad
ad = Target.Address
'将活动单元格所在的列号减7后赋值给变量c
c = Target.Column - 7
'将获取的单元格值赋值给变量rq
rq = Target.Offset(0, -c)
'使用Find方法在49行至504行单元格区域内查找
Set r1 = Rows("49:504").Find(rq, , , 1)
'如果找到
If Not r1 Is Nothing Then
'写入当前活动单元格的值
Cells(r1.Row, r1.Column).Offset(0, c) = Target.Value
End If
End Sub
'单元格激活时触发事件
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'如果活动单元格大于2时停止程序
If Target.Count > 2 Then Exit Sub
'使用Intersect方法判断所选单元格
If Intersect([a1:m1], Target) Is Nothing Then Exit Sub
'声明变量
Dim yf$, r1, rng As Range
'将活动单元格的位置赋值给变量yf
yf = Target.Value
'使用Find方法在49行至504行单元格区域内查找
Set r1 = Rows("49:504").Find(yf, , , 1)
'如果找到
If Not r1 Is Nothing Then
'赋值给变量rng
Set rng = Range(r1.Address).CurrentRegion
'将变量rng 的值复制到B2单元格
rng.Copy [b2]
End If
End Sub