 Option Explicit Private Sub bianhao_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) ListBox1.Visible = True '編號智能提示輸入 ListBox1.Clear Dim arr, arr1 arr = Range("a2", [a2].End(xlDown)) arr1 = Filter(Application.Transpose(arr), bianhao.Value, True) ListBox1.List = arr1 End Sub Private Sub UserForm_Initialize() ListBox1.Visible = False '窗體隱藏列表框 ListBox2.Visible = False ListBox3.Visible = False ListBox4.Visible = False With ListBox1 .Top = bianhao.Top + bianhao.Height .Left = bianhao.Left .Width = bianhao.Width .Height = 50 End With With ListBox2 .Top = xingming.Top + xingming.Height .Left = xingming.Left .Width = xingming.Width .Height = 50 End With With ListBox3 .Top = jiguan.Top + jiguan.Height .Left = jiguan.Left .Width = jiguan.Width .Height = 50 End With With ListBox4 .Top = zhiwu.Top + zhiwu.Height .Left = zhiwu.Left .Width = zhiwu.Width .Height = 50 End With End Sub Private Sub xingming_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) ListBox2.Visible = True '姓名智能提示輸入 ListBox2.Clear Dim arr, arr1 arr = Range("b2", [b2].End(xlDown)) arr1 = Filter(Application.Transpose(arr), xingming.Value, True) ListBox2.List = arr1 End Sub Private Sub jiguan_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) ListBox3.Visible = True '籍貫智能提示輸入 ListBox3.Clear On Error Resume Next Dim arr, arr1, m%, d As New Dictionary '定義字典 Set d = CreateObject("scripting.dictionary") '調(diào)用字典 arr = Range("d2", [d2].End(xlDown)) For m = 1 To UBound(arr) d.Add arr(m, 1), "" '字典去重 Next arr1 = Filter(d.Keys, jiguan.Value, True) ListBox3.List = arr1 End Sub Private Sub zhiwu_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) ListBox4.Visible = True '職務(wù)智能提示輸入 ListBox4.Clear On Error Resume Next Dim arr, arr1, m%, d As New Dictionary Set d = CreateObject("scripting.dictionary") arr = Range("f2", [f2].End(xlDown)) For m = 1 To UBound(arr) d.Add arr(m, 1), "" Next arr1 = Filter(d.Keys, zhiwu.Value, True) ListBox4.List = arr1 End Sub Private Sub ListBox2_Click() '姓名列表框2點擊事件 xingming = ListBox2.Text ListBox2.Visible = False End Sub Private Sub ListBox3_Click() '籍貫列表框2點擊事件 jiguan = ListBox3.Text ListBox3.Visible = False End Sub Private Sub ListBox1_Click() '編號列表框1點擊事件 bianhao = ListBox1.Text ListBox1.Visible = False End Sub Private Sub ListBox4_Click() '職務(wù)列表框1點擊事件 zhiwu = ListBox4.Text ListBox4.Visible = False End Sub Private Sub UserForm_Click() '點擊窗體隱藏列表框 ListBox1.Visible = False ListBox2.Visible = False ListBox3.Visible = False ListBox4.Visible = False End Sub Private Sub 查詢_Click() Dim a As Range, b As Range Set a = Range("a2", [a2].End(xlDown)).Find(bianhao.Value) Set b = Range("b2", [b2].End(xlDown)).Find(xingming.Value) If Not a Is Nothing Then xingming = a(, 2) If lan.Caption = a(, 3) Then lan = True If nv.Caption = a(, 3) Then nv = True jiguan = a(, 4) chusheng = a(, 5) zhiwu = a(, 6) beizhu = a(, 7) Application.Goto a, True ElseIf Not b Is Nothing Then bianhao = b(, 0) If lan.Caption = b(, 2) Then lan = True If nv.Caption = b(, 2) Then nv = True jiguan = b(, 3) chusheng = b(, 4) zhiwu = b(, 5) beizhu = b(, 6) Application.Goto b, True Else MsgBox "對不起，你查找的資料不存在！" End If End Sub Private Sub 清空_Click() Dim con As Control '清空控件中的內(nèi)容 For Each con In Me.Controls If TypeName(con) = "TextBox" Then con = "" Next End Sub Private Sub 新增_Click() ActiveSheet.Unprotect "123" Dim a As Range, b As Range, arr Set a = [a65536].End(xlUp)(2) Set b = Range("a2", [a2].End(xlDown)).Find(bianhao.Value) If Not b Is Nothing Then MsgBox "此編號已被使用" ElseIf lan = True Then arr = Array(bianhao.Text, xingming.Text, lan.Caption, jiguan.Text, _ chusheng.Text, zhiwu.Text, beizhu.Text) a.Resize(, 7) = arr ElseIf nv = True Then arr = Array(bianhao.Text, xingming.Text, nv.Caption, jiguan.Text, _ chusheng.Text, zhiwu.Text, beizhu.Text) a.Resize(, 7) = arr End If With [a:g] .Font.Size = 10 .EntireColumn.AutoFit .HorizontalAlignment = xlCenter End With a.Resize(, 7).Borders.LineStyle = xlContinuous ActiveSheet.Protect "123", True, True, True ThisWorkbook.Save End Sub Private Sub 修改_Click() ActiveSheet.Unprotect "123" Dim a As Range, b As Range, arr Set a = Range("a2", [a2].End(xlDown)).Find(bianhao.Value) Set b = Range("b2", [b2].End(xlDown)).Find(xingming.Value) If Not a Is Nothing Then If lan = True Then arr = Array(bianhao.Text, xingming.Text, lan.Caption, jiguan.Text, _ chusheng.Text, zhiwu.Text, beizhu.Text) a.Resize(, 7) = arr ElseIf nv = True Then arr = Array(bianhao.Text, xingming.Text, nv.Caption, jiguan.Text, _ chusheng.Text, zhiwu.Text, beizhu.Text) a.Resize(, 7) = arr End If Application.Goto a, True ElseIf Not b Is Nothing Then If lan = True Then arr = Array(bianhao.Text, xingming.Text, lan.Caption, jiguan.Text, _ chusheng.Text, zhiwu.Text, beizhu.Text) b(, 0).Resize(, 7) = arr ElseIf nv = True Then arr = Array(bianhao.Text, xingming.Text, nv.Caption, jiguan.Text, _ chusheng.Text, zhiwu.Text, beizhu.Text) b(, 0).Resize(, 7) = arr End If Application.Goto b, True End If ActiveSheet.Protect "123", True, True, True ThisWorkbook.Save End Sub |
|
|
