关于单元格点击的求助

yooha

新建 Microsoft Office Excel 2007 工作表.zip (7.36 KB, 下载次数: 8)

2018-8-10 07:53 上传

点击文件名下载附件

例子如附件,请问点击姓名后在其他单元格自动填入年龄、编号、单位等其他项该如何实现，谢谢！

heqinghui1988

刚开始学习，勉强可以用。

1. Public k As Long
   
2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
3.    
   
4.     If (Target.Row <= [b63355].End(3).Row()) And (Target.Row > 1) And (Target.Column = 2) Then
   
5.     findlst (Target)
   
6.     Sheet2.Range("d" & Sheet2.Range("d65536").End(xlUp).Row + 1) = Cells(k, Target.Column)
   
7.     Sheet2.Range("d" & Sheet2.Range("d65536").End(xlUp).Row).Offset(0, 2) = Cells(k, Target.Column - 1)
   
8.     Sheet2.Range("d" & Sheet2.Range("d65536").End(xlUp).Row).Offset(0, 4) = Cells(k, Target.Column + 1)
   
9.     Sheet2.Range("d" & Sheet2.Range("d65536").End(xlUp).Row).Offset(0, 6) = Cells(k, Target.Column + 2)
   
10.     End If
    
11. End Sub
    
12. Sub findlst(str As String)
    
13.       Dim i
    
14.       For i = [a63355].End(3).Row() To 2 Step -1
    
15.           If Cells(i, 2) = str Then
    
16.              k = i
    
17.              Exit Sub
    
18.           End If
    
19.       Next
    
20. End Sub
    

复制代码

jiangxiaoyun

新建 Microsoft Excel 工作表 - 副本 (2).zip (14.22 KB, 下载次数: 2)

2018-8-10 10:39 上传

点击文件名下载附件

鼠标双击吧

莫名v微笑

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. If Target.Rows.Count > 1 And Target.Columns.Count > 1 Then Exit Sub
   
3. arr = Sheets(1).UsedRange
   
4. a = Sheets(2).UsedRange.Rows.Count
   
5. ReDim crr(1 To 1, 1 To 8)
   
6. For i = 2 To UBound(arr)
   
7. If Target = arr(i, 2) Then b = i
   
8. Next
   
9. If b <> 0 Then
   
10. crr(1, 2) = arr(b, 2): crr(1, 4) = arr(b, 1): crr(1, 6) = arr(b, 3): crr(1, 8) = arr(b, 4)
    
11. crr(1, 1) = "姓名：": crr(1, 3) = "编号:": crr(1, 5) = "年龄:": crr(1, 7) = "单位:"
    
12. Sheets(2).Cells(a, 4).Resize(UBound(crr), UBound(crr, 2)) = crr
    
13. End If
    
14. End Sub

复制代码

yooha

莫名v微笑 发表于 2018-8-10 11:24

还想请问如果是直接引用填写 所点击的姓名所在得行的数据该怎么做呢?