跨表自动记录输入并查找提示【zhaogang1960老师赐教下解决】

lisan · 发表于 2011-1-4 17:42

如附件，身份证号输入.xls的sheet!A1输入身份证号，希望达到以下效果：
1、在人员信息.xls的sheet!A列自动记录每次输入的身份证号码。（若需要处于打开状态，可事先打开人员信息.xls）
2、自动在人员信息.xls的Agent Info表中（人员很多，附件予以简化）查找（H、J、L、N、P、R列）是否存在以上每次输入的身份证号。
若不存在，则在人员信息.xls的sheet!B列提示“不存在”。
若存在，则在人员信息.xls的sheet!B列显示该身份证号对应的姓名及其对应D列的姓名及关系（本人、父亲、母亲、夫妻、子女一、子女二）。
如：在身份证号输入.xls的sheet!A1输入230500400126071，则在人员信息.xls的sheet!A1记录230500400126071，并在人员信息.xls的sheet!B1显示 孙玉学 - 孙艳（父亲）。
烦请高手予以赐教。谢谢！

问题.rar (2.67 KB, 下载次数: 13)

[ 本帖最后由 lisan 于 2011-1-4 20:30 编辑 ]

lisan · 发表于 2011-1-4 18:36

问题应该说得很清楚呀。顶上去再求赐教。

zhaogang1960 · 发表于 2011-1-4 19:17

试试看：

问题.rar (11.3 KB, 下载次数: 36)

lisan · 发表于 2011-1-4 19:26

我的神啊！谢谢！
我的意思是能显示孙玉学 - 孙艳（父亲），烦请zhaogang1960 老师再修改一下。
另弱弱的问一句，VBA代码一定要写在身份证号输入.xls上吗？能不能写在人员信息.xls？

zhaogang1960 · 发表于 2011-1-4 19:55

原帖由 lisan 于 2011-1-4 19:26 发表
我的神啊！谢谢！
我的意思是能显示孙玉学 - 孙艳（父亲），烦请zhaogang1960 老师再修改一下。
另弱弱的问一句，VBA代码一定要写在身份证号输入.xls上吗？能不能写在人员信息.xls？

不能写在人员信息.xls，因为触发程序的动作是在身份证号输入.xls上发出的

问题.rar (14.73 KB, 下载次数: 39)

lisan · 发表于 2011-1-4 20:07

十分感谢zhaogang1960老师的赐教。
1、如果是本人，也希望按这种格式孙艳 - 孙艳（本人）。
2、能否用什么方法，不要将VBA代码写在身份证号输入.xls上（身份证号输入.xls无法修改），又能解决问题？
3、在人员信息.xls sheet!A列的记录能不能不要直接保存（由使用者关闭时再决定是否保存）？
烦请zhaogang1960老师再赐教，谢谢！

[ 本帖最后由 lisan 于 2011-1-4 20:12 编辑 ]

zhaogang1960 · 发表于 2011-1-4 20:13

原帖由 lisan 于 2011-1-4 20:07 发表
十分感谢zhaogang1960老师的赐教。
1、能否用什么方法，不要将VBA代码写在身份证号输入.xls上（身份证号输入.xls无法修改），又能解决问题？
2、在人员信息.xls sheet!A列的记录能不能不要直接保存（由使用者关闭时 ...

1、如果要在身份证号输入.xls上输入，那就得把vba写在上面，否则无法触发Worksheet_Change过程
2、把ThisWorkbook代码区中的Workbook_BeforeClose事件代码删除就可以了

lisan · 发表于 2011-1-4 20:20

如果是本人，也希望按这种格式孙艳 - 孙艳（本人）。

zhaogang1960 · 发表于 2011-1-4 20:27

原帖由 lisan 于 2011-1-4 20:20 发表
如果是本人，也希望按这种格式孙艳 - 孙艳（本人）。

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) <> "A1" Then Exit Sub
If Target = "" Then Exit Sub
Dim wb As Workbook, c As Range, s$
s = Target
On Error Resume Next
Application.ScreenUpdating = False
Set wb = Workbooks("人员信息.xls")
If wb Is Nothing Then Set wb = Workbooks.Open(ThisWorkbook.Path & "\人员信息.xls")
wb.Sheets("Sheet1").[a65536].End(xlUp).Offset(1) = Target
With wb.Sheets("Agent Info")
      Set c = .UsedRange.Offset(, 7).Find(s, , , xlWhole)
      If Not c Is Nothing Then
         If c.Column = 8 Then
            wb.Sheets("Sheet1").[a65536].End(xlUp).Offset(, 1) = c.Offset(, -3) & "-" & c.Offset(, -3) & "(本人)"
         Else
            wb.Sheets("Sheet1").[a65536].End(xlUp).Offset(, 1) = c.Offset(, -1) & "-" & .Cells(c.Row, 5) & "(" & Replace(.Cells(1, c.Column - 1), "姓名", "") & ")"
         End If
      Else
         wb.Sheets("Sheet1").[a65536].End(xlUp).Offset(, 1) = "不存在"
      End If
End With
Me.Activate
Application.ScreenUpdating = True
End Sub

lisan · 发表于 2011-1-4 20:30

十分感谢zhaogang1960老师不厌其烦的赐教！问题解决！

		自动登录	找回密码
密码			免费注册

[已解决] 跨表自动记录输入并查找提示【zhaogang1960老师赐教下解决】