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
