Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 7832|回复: 11

[已解决]窗体录入修改查询信息表

[复制链接]
发表于 2013-11-17 20:03 | 显示全部楼层 |阅读模式
请各位老师帮忙修改一下代码功能,设计一个窗体能录入、修改、查询所有人员信息(在三个工作表中都应用),多谢。
最佳答案
2013-11-17 21:17
  1. Private Sub CommandButton1_Click()
  2.     Dim wsrg As Range
  3.     Dim hang%
  4.     On Error GoTo 判断
  5.     Set wsrg = ActiveSheet.Range("B1")  '查询数据源"数据表"工作表名称.B1人员姓名标题所在单元格
  6.     hang = WorksheetFunction.Match(ListBox1.Value, wsrg.Parent.Range("B:B"), 0)    'B:B是指姓名所在的列
  7.     ActiveWindow.ScrollRow = hang  '选中的当前人员所在行滚动至工作表最顶端
  8.     Rows(hang).Select              '选中当前人员所在的行
  9.     Unload Me                      '关闭当前的窗体
  10.     Exit Sub
  11. 判断:
  12.     MsgBox "没有选择查询人员!"
  13. End Sub
  14. Private Sub ListBox1_Click()
  15.     Dim wsrg As Range
  16.     Dim hang%
  17.     Set wsrg = ActiveSheet.Range("B1")                 '查询数据源"数据表"工作表名称,B1人员姓名标题所在单元格
  18.     姓名.Caption = ListBox1.Value                         '姓名.Caption中的"姓名"是文本框的名称属性,下同理
  19.     hang = WorksheetFunction.Match(姓名.Caption, wsrg.Parent.Range("B:B"), 0)    'B:B是指姓名所在的列
  20.     科室.Caption = ActiveSheet.Cells(hang, "D").Value  '其中"数据表"是查询数据源工作表名,D是科室文本框对应数据的列位置,下同理
  21.     性别.Caption = ActiveSheet.Cells(hang, "Q").Value
  22.     受聘专业.Caption = ActiveSheet.Cells(hang, "J").Value
  23.     职务.Caption = ActiveSheet.Cells(hang, "O").Value
  24.     是否干部.Caption = ActiveSheet.Cells(hang, "S").Value
  25.     最高级别.Caption = ActiveSheet.Cells(hang, "F").Value
  26.     技术职称.Caption = ActiveSheet.Cells(hang, "G").Value
  27.     资格证书.Caption = ActiveSheet.Cells(hang, "T").Value
  28.     技术等级.Caption = ActiveSheet.Cells(hang, "W").Value
  29.     身份.Caption = ActiveSheet.Cells(hang, "E").Value
  30.     年龄.Caption = ActiveSheet.Cells(hang, "M").Value
  31.     年龄.Caption = ActiveSheet.Cells(hang, "M").Value
  32.     出生日期.Caption = Format(ActiveSheet.Cells(hang, "L").Value, "yyyy-mm-dd")  '出生年月所在单元格及窗体中日期显示的格式
  33.     工作时间.Caption = Format(ActiveSheet.Cells(hang, "N").Value, "yyyy-mm-dd")
  34.     With wsrg.Parent
  35.     End With
  36. End Sub
  37. Private Sub TextBox1_Change()
  38.     Dim lastrow%
  39.     Dim myrg As Range
  40.     TextBox1.Text = UCase(TextBox1.Text)
  41.     ListBox1.Clear
  42.     If TextBox1.Text = "" Then
  43.         Label3 = 0
  44.         Exit Sub
  45.     End If
  46.     lastrow = ActiveSheet.Range("B65536").End(xlUp).Row        '其中"数据表"查询数据源工作表名称,B65536中的B表示姓名所在的列
  47.     For Each myrg In ActiveSheet.Range("C2:C" & CStr(lastrow)) '其中"数据表"查询数据源工作表名称,"C2:C"拼音简码所在列
  48.         If Right(TextBox1.Text, 1) = "0" Then
  49.             If myrg = Left(TextBox1.Text, Len(TextBox1.Text)) Then ListBox1.AddItem ActiveSheet.Cells(myrg.Row, "B").Value  '"B"指姓名所在列
  50.         Else
  51.             If myrg Like "*" & TextBox1.Text & "*" Then ListBox1.AddItem ActiveSheet.Cells(myrg.Row, "B").Value  '"B"指姓名所在列
  52.         End If
  53.     Next
  54.     Label3.Caption = ListBox1.ListCount
  55. End Sub
  56. Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  57.     If KeyCode = vbKeyDown Then
  58.         If ListBox1.ListCount > 0 Then
  59.             ListBox1.ListIndex = 0
  60.             ListBox1.SetFocus
  61.         End If
  62.     End If
  63. End Sub
复制代码

VBA窗体录入修改查询人员信息表.rar

33.67 KB, 下载次数: 198

发表于 2013-11-17 21:16 | 显示全部楼层
在 查询窗口 的代码里,查找 Sheets("数据表") 替换为 activesheet 就成了。
回复

使用道具 举报

发表于 2013-11-17 21:17 | 显示全部楼层    本楼为最佳答案   
  1. Private Sub CommandButton1_Click()
  2.     Dim wsrg As Range
  3.     Dim hang%
  4.     On Error GoTo 判断
  5.     Set wsrg = ActiveSheet.Range("B1")  '查询数据源"数据表"工作表名称.B1人员姓名标题所在单元格
  6.     hang = WorksheetFunction.Match(ListBox1.Value, wsrg.Parent.Range("B:B"), 0)    'B:B是指姓名所在的列
  7.     ActiveWindow.ScrollRow = hang  '选中的当前人员所在行滚动至工作表最顶端
  8.     Rows(hang).Select              '选中当前人员所在的行
  9.     Unload Me                      '关闭当前的窗体
  10.     Exit Sub
  11. 判断:
  12.     MsgBox "没有选择查询人员!"
  13. End Sub
  14. Private Sub ListBox1_Click()
  15.     Dim wsrg As Range
  16.     Dim hang%
  17.     Set wsrg = ActiveSheet.Range("B1")                 '查询数据源"数据表"工作表名称,B1人员姓名标题所在单元格
  18.     姓名.Caption = ListBox1.Value                         '姓名.Caption中的"姓名"是文本框的名称属性,下同理
  19.     hang = WorksheetFunction.Match(姓名.Caption, wsrg.Parent.Range("B:B"), 0)    'B:B是指姓名所在的列
  20.     科室.Caption = ActiveSheet.Cells(hang, "D").Value  '其中"数据表"是查询数据源工作表名,D是科室文本框对应数据的列位置,下同理
  21.     性别.Caption = ActiveSheet.Cells(hang, "Q").Value
  22.     受聘专业.Caption = ActiveSheet.Cells(hang, "J").Value
  23.     职务.Caption = ActiveSheet.Cells(hang, "O").Value
  24.     是否干部.Caption = ActiveSheet.Cells(hang, "S").Value
  25.     最高级别.Caption = ActiveSheet.Cells(hang, "F").Value
  26.     技术职称.Caption = ActiveSheet.Cells(hang, "G").Value
  27.     资格证书.Caption = ActiveSheet.Cells(hang, "T").Value
  28.     技术等级.Caption = ActiveSheet.Cells(hang, "W").Value
  29.     身份.Caption = ActiveSheet.Cells(hang, "E").Value
  30.     年龄.Caption = ActiveSheet.Cells(hang, "M").Value
  31.     年龄.Caption = ActiveSheet.Cells(hang, "M").Value
  32.     出生日期.Caption = Format(ActiveSheet.Cells(hang, "L").Value, "yyyy-mm-dd")  '出生年月所在单元格及窗体中日期显示的格式
  33.     工作时间.Caption = Format(ActiveSheet.Cells(hang, "N").Value, "yyyy-mm-dd")
  34.     With wsrg.Parent
  35.     End With
  36. End Sub
  37. Private Sub TextBox1_Change()
  38.     Dim lastrow%
  39.     Dim myrg As Range
  40.     TextBox1.Text = UCase(TextBox1.Text)
  41.     ListBox1.Clear
  42.     If TextBox1.Text = "" Then
  43.         Label3 = 0
  44.         Exit Sub
  45.     End If
  46.     lastrow = ActiveSheet.Range("B65536").End(xlUp).Row        '其中"数据表"查询数据源工作表名称,B65536中的B表示姓名所在的列
  47.     For Each myrg In ActiveSheet.Range("C2:C" & CStr(lastrow)) '其中"数据表"查询数据源工作表名称,"C2:C"拼音简码所在列
  48.         If Right(TextBox1.Text, 1) = "0" Then
  49.             If myrg = Left(TextBox1.Text, Len(TextBox1.Text)) Then ListBox1.AddItem ActiveSheet.Cells(myrg.Row, "B").Value  '"B"指姓名所在列
  50.         Else
  51.             If myrg Like "*" & TextBox1.Text & "*" Then ListBox1.AddItem ActiveSheet.Cells(myrg.Row, "B").Value  '"B"指姓名所在列
  52.         End If
  53.     Next
  54.     Label3.Caption = ListBox1.ListCount
  55. End Sub
  56. Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  57.     If KeyCode = vbKeyDown Then
  58.         If ListBox1.ListCount > 0 Then
  59.             ListBox1.ListIndex = 0
  60.             ListBox1.SetFocus
  61.         End If
  62.     End If
  63. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2013-11-18 11:23 | 显示全部楼层
请问hwc2ycy 老师:能否帮我根据窗体设计修改一下代码吗?多谢。如附件

学生个人信息登记窗口.rar

21.75 KB, 下载次数: 67

回复

使用道具 举报

发表于 2013-11-18 12:48 | 显示全部楼层
用ACCESS实现更方便
回复

使用道具 举报

 楼主| 发表于 2013-11-18 14:14 | 显示全部楼层
QLZ0602 发表于 2013-11-18 12:48
用ACCESS实现更方便

QLZ0602老师怎样操作,请指教,多谢。

学生个人信息登记窗口1.rar

21.39 KB, 下载次数: 58

回复

使用道具 举报

发表于 2013-11-18 14:21 | 显示全部楼层
首先 你的电脑上有没有装 ACCESS系统  也是微软的
回复

使用道具 举报

 楼主| 发表于 2013-11-18 14:33 | 显示全部楼层
QLZ0602 发表于 2013-11-18 14:21
首先 你的电脑上有没有装 ACCESS系统  也是微软的

我的电脑上有装 ACCESS系统
回复

使用道具 举报

发表于 2013-11-18 15:10 | 显示全部楼层
你会建立  access表、窗体吗? www.ACCESSOFT.COM有教程
回复

使用道具 举报

 楼主| 发表于 2013-11-18 15:30 | 显示全部楼层
QLZ0602 发表于 2013-11-18 15:10
你会建立  access表、窗体吗? www.ACCESSOFT.COM有教程

本人知识有限,不会建立,你可以帮忙做一个吗?多谢。
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 03:09 , Processed in 0.378560 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表