VBA常用技巧代码解析

随心而动

留个脚印来慢慢消化，谢谢楼主！

yenty

太好了，这正是我最梦寐以求的。
谢谢楼主！

liuy1212

非常感谢！！！敬礼

375268527

谢谢分享，下载收藏了

lmj4997

正好学习学习~~~~

viewing

词典般的巨作，收藏了。

zhaokai

非常感谢！！！敬礼

rekines

辛苦了，非常需要，谢谢。

wangfengcpa

巨作，巨强，巨需要的资料。

yuanzhuping

技巧198         职工考勤系统
       笔者所在单位没有使用电子考勤，每到月底各部门需手工填写部门所有职工的考勤考核表及部门的考勤汇总表，工作量大、出错机率高、统计分析麻烦，因此使用VBA开发的考勤系统可以使部门考勤员简化工作，提高工作效率。
       步骤1，新建工作簿，将Sheet1工作表名称重命名为“资料”，设置成如图所示的格式，用来保存考勤系统使用过程中必需的资料。
“资料”表中的B1单元格保存单位的名称，B2单元格保存考勤周期中开始考勤的日期，第三行以下用于保存考勤部门的资料，其中第四列往右的单元格保存部门职工的资料。

       步骤2，在VBE窗口中单击菜单“插入”→“插入窗体”，在窗体中添加一个框架控件和两个按钮按件，在框架控件添加两个标签控件、一个文本框控件及一个组合框控件，调整好控件的大小与位置，如图所示。

       单位设置窗体用于设置使用单位及开始考勤的日期，双击窗体，在打开的代码窗口写入下面的代码：

1. #001  Private Sub UserForm_Initialize()
   
2. #002      Dim arr As Variant
   
3. #003      TextBox1.SetFocus
   
4. #004      arr = Array("26日-25日", "27日-26日", "28日-27日", "1日-31日", "2日-1日", "3日-2日", "4日-3日", "5日-4日")
   
5. #005      With ComboBox1
   
6. #006          .List = arr
   
7. #007          .ListIndex = 0
   
8. #008      End With
   
9. #009  End Sub

复制代码

代码解析：
       单位设置窗体的初始化事件，为组合框控件添加考勤周期。
       双击窗体中的“确定”按钮，在打开的代码窗口写入下面的代码：

1. #001  Private Sub CommandButton1_Click()
   
2. #002      If Trim(TextBox1) = "" Then
   
3. #003          MsgBox "请输入单位名称!", 64, "提示"
   
4. #004          TextBox1.SetFocus
   
5. #005          Exit Sub
   
6. #006      End If
   
7. #007      With Sheet1
   
8. #008          .Cells(1, 2) = Trim(TextBox1.Text)
   
9. #009          .Cells(2, 2) = Val(ComboBox1.Text)
   
10. #010          Application.Caption = .Cells(1, 2)
    
11. #011      End With
    
12. #012      Unload Me
    
13. #013  End Sub

复制代码

代码解析：
       单位设置窗体中“确定”按钮的单击事件，将输入的单位名称及考勤周期的开始日期录入到”资料”表中并更新工作簿标题。
       步骤3，在VBE窗口中单击菜单“插入”→“插入窗体”，在窗体中添加一个MultiPage（多页）控件，将MultiPage控件中的Page分别重命名为“增加”、“删除”和“编辑”。
       在“增加”页中添加一个框架控件和两个按钮按件，在框架控件添加三个标签控件及三个文本框控件，调整好控件的大小与位置，如图所示。

       双击“增加”按钮，在打开的代码窗口写入下面的代码：

1. #001  Private Sub CommandButton1_Click()
   
2. #002      Dim r As Integer
   
3. #003      Dim i As Integer
   
4. #004      r = Sheet1.Range("A65536").End(xlUp).Row
   
5. #005      If Trim(MultiPage1.Page1.TextBox1.Text) = "" Then
   
6. #006          MsgBox "请输入部门名称!", 64, "提示"
   
7. #007          MultiPage1.Page1.TextBox1.SetFocus
   
8. #008          Exit Sub
   
9. #009      End If
   
10. #010      If Application.CountIf(Sheet1.Range("A:A"), MultiPage1.Page1.TextBox1.Text) > 0 Then
    
11. #011          MsgBox "部门名称已经存在,请重新输入!", 64, "提示"
    
12. #012          MultiPage1.Page1.TextBox1.SetFocus
    
13. #013          Exit Sub
    
14. #014      End If
    
15. #015      If Trim(MultiPage1.Page1.TextBox2.Text) = "" Then
    
16. #016          MsgBox "请输入部门负责人姓名!", 64, "提示"
    
17. #017          MultiPage1.Page1.TextBox2.SetFocus
    
18. #018          Exit Sub
    
19. #019      End If
    
20. #020      If Trim(MultiPage1.Page1.TextBox3.Text) = "" Then
    
21. #021          MsgBox "请输入考勤员姓名!", 64, "提示"
    
22. #022          MultiPage1.Page1.TextBox3.SetFocus
    
23. #023          Exit Sub
    
24. #024      End If
    
25. #025      For i = 1 To 3
    
26. #026          Sheet1.Cells(r + 1, i) = MultiPage1.Page1.Controls("TextBox" & i)
    
27. #027      Next
    
28. #028      MsgBox "部门已成功增加,请增加部门人员!", 64, "提示"
    
29. #029      Unload Me
    
30. #030  End Sub

复制代码

代码解析：
       部门设置窗体中“增加”按钮的单击事件，将输入的部门名称、部门负责人及部门考勤员录入到”资料”表中。
       第5行到第9行代码，判断是否已输入部门名称。
       第10行到第14行代码，判断输入的部门名称是否重复。
       第15行到第19行代码，判断是否已输入部门负责人姓名。
       第20行到第24行代码，判断是否已输入部门考勤员姓名。
       第25行到第27行代码，将所输入的部门信息录入中资料表的最后一行。
       在“删除”页中添加一个框架控件和两个按钮按件，在框架控件添加一个列表框控件，调整好控件的大小与位置，如图所示。

       双击“删除”按钮，在打开的代码窗口写入下面的代码：

1. #001  Private Sub CommandButton2_Click()
   
2. #002      Dim r As Integer
   
3. #003      Dim s As String
   
4. #004      Dim i As Integer
   
5. #005      r = Sheet1.Range("a65536").End(xlUp).Row
   
6. #006      If MultiPage1.Page2.ListBox1.ListIndex < 0 Then
   
7. #007          MsgBox "请选择需要删除的部门!", 64, "提示"
   
8. #008          Exit Sub
   
9. #009      End If
   
10. #010      s = MultiPage1.Page2.ListBox1.Text
    
11. #011      If MsgBox("确定要删除" & s & "吗?", 36, "警告") = 6 Then
    
12. #012          For i = 4 To r
    
13. #013              If s = Sheet1.Cells(i, 1) Then
    
14. #014                  Sheet1.Cells(i, 1).EntireRow.Delete
    
15. #015                  MultiPage1.Page2.ListBox1.RemoveItem (ListBox1.ListIndex)
    
16. #016                  MsgBox s & "已经成功删除!", 64, "提示"
    
17. #017              End If
    
18. #018          Next
    
19. #019      End If
    
20. #020      Unload Me
    
21. #021  End Sub

复制代码

代码解析：
       部门设置窗体中“删除”按钮的单击事件，删除“资料”表中已保存的部门资料。
       第6行到第9行代码，判断在列表框中是否已选择了要删除的部门。
       第10行代码，将所要删除的部门名称赋给变量s。
       第14行代码，将“资料”表中该部门所在的行删除。
       第15行代码，将列表框中该部门所在的行删除。
       在“编辑”页中添加一个框架控件和两个按钮按件，在框架控件添加四个标签控件、一个组合框控件及三个文本框控件，调整好控件的大小与位置，如图所示。

       双击窗体中的组合框控件，在打开的代码窗口写入下面的代码：

1. #001  Private Sub ComboBox1_Change()
   
2. #002      Dim r As Integer
   
3. #003      Dim c As Integer
   
4. #004      For r = 4 To Sheet1.Range("A65536").End(xlUp).Row
   
5. #005          If MultiPage1.Page3.ComboBox1 = Sheet1.Cells(r, 1) Then
   
6. #006              For c = 1 To 3
   
7. #007                  MultiPage1.Page3.Controls("TextBox" & c + 3) = Sheet1.Cells(r, c)
   
8. #008              Next
   
9. #009          End If
   
10. #010      Next
    
11. #011  End Sub

复制代码

代码解析：
       组合框控件的Change事件，当用户选择所需编辑的部门名称后，文本框中显示该部门编辑前的信息。
       双击“编辑”按钮，在打开的代码窗口写入下面的代码：

1. #001  Private Sub CommandButton3_Click()
   
2. #002      Dim r As Integer
   
3. #003      Dim i As Integer
   
4. #004      Dim j As Integer
   
5. #005      r = Sheet1.Range("A65536").End(xlUp).Row
   
6. #006      If MultiPage1.Page3.ComboBox1.ListIndex < 0 Then
   
7. #007          MsgBox "请选择需要编辑的部门名称!", 64, "提示"
   
8. #008          Exit Sub
   
9. #009      End If
   
10. #010      If Trim(MultiPage1.Page3.TextBox4.Text) = "" Then
    
11. #011          MsgBox "部门名称不能为空!", 64, "提示"
    
12. #012          MultiPage1.Page3.TextBox4.SetFocus
    
13. #013          Exit Sub
    
14. #014      End If
    
15. #015      If Trim(MultiPage1.Page3.TextBox5.Text) = "" Then
    
16. #016          MsgBox "部门负责人不能为空!", 64, "提示"
    
17. #017          MultiPage1.Page3.TextBox5.SetFocus
    
18. #018          Exit Sub
    
19. #019      End If
    
20. #020      If Trim(MultiPage1.Page3.TextBox6.Text) = "" Then
    
21. #021          MsgBox "部门考勤员不能为空!", 64, "提示"
    
22. #022          MultiPage1.Page3.TextBox6.SetFocus
    
23. #023          Exit Sub
    
24. #024      End If
    
25. #025      If MsgBox("是否重新编辑" & MultiPage1.Page3.ComboBox1 & "的信息?", 36, "提示") = 6 Then
    
26. #026          For i = 4 To r
    
27. #027              If MultiPage1.Page3.ComboBox1 = Sheet1.Cells(i, 1) Then
    
28. #028                  For j = 1 To 3
    
29. #029                      Sheet1.Cells(i, j) = MultiPage1.Page3.Controls("TextBox" & j + 3)
    
30. #030                  Next
    
31. #031              End If
    
32. #032          Next
    
33. #033      End If
    
34. #034      Unload Me
    
35. #035  End Sub

复制代码

代码解析：
       部门设置窗体中“编辑”按钮的单击事件，编辑“资料”表中已保存的部门信息。
       第6行到第9行代码，判断是否已选择了部门。
       第10行到第14行代码，判断部门名称是否为空。
       第15行到第19行代码，判断部门负责人是否为空。
       第20行到第24行代码，判断部门考勤员是否为空。
       第26行到第32行代码，将重新编辑的部门信息录入中资料表该部门所在的行中。
       步骤4，在VBE窗口中单击菜单“插入”→“插入窗体”，在窗体中添加一个框架控件及一个按钮控件，在框架控件中添加两个标签控件、两个按钮控件、一个组合框控件、一个文本框控件及一个列表框控件，如图所示。

       双击窗体，在打开的代码窗口写入下面的代码：

1. #001  Private Sub UserForm_Initialize()
   
2. #002      Dim i As Integer
   
3. #003      For i = 4 To Sheet1.Range("A65536").End(xlUp).Row
   
4. #004          ComboBox1.AddItem Sheet1.Cells(i, 1)
   
5. #005      Next
   
6. #006      ComboBox1.ListIndex = -1
   
7. #007  End Sub

复制代码

代码解析：
       人员设置窗体的初始化事件，为组合框控件添加部门名称。
       双击窗体上的组合框控件，在打开的代码窗口写入下面的代码：

1. #001  Private Sub ComboBox1_Change()
   
2. #002      Dim r As Integer
   
3. #003      Dim c As Integer
   
4. #004      For r = 4 To Sheet1.Range("A65536").End(xlUp).Row
   
5. #005          If ComboBox1.Text = Sheet1.Cells(r, 1) Then
   
6. #006              ListBox1.Clear
   
7. #007              For c = 4 To Sheet1.Cells(r, 255).End(xlToLeft).Column
   
8. #008                  ListBox1.AddItem Sheet1.Cells(r, c).Value
   
9. #009              Next
   
10. #010          End If
    
11. #011      Next
    
12. #012      TextBox1.SetFocus
    
13. #013  End Sub

复制代码

代码解析：
       组合框控件的Change事件，当用户选择所需增加或删除人员的部门名称后，文本框中显示该部门中已有的人员姓名。
       双击窗体上的“增加”按钮，在打开的代码窗口写入下面的代码：

1. #001  Private Sub CommandButton1_Click()
   
2. #002      Dim i As Integer
   
3. #003      Dim c As Integer
   
4. #004      If ComboBox1.Text = "" Then
   
5. #005          MsgBox "请选择增加人员的部门!", 64, "提示"
   
6. #006          Exit Sub
   
7. #007      End If
   
8. #008      If Trim(TextBox1.Text) = "" Then
   
9. #009          MsgBox "请输入人员姓名!", 64, "提示"
   
10. #010          TextBox1.SetFocus
    
11. #011          Exit Sub
    
12. #012      End If
    
13. #013      With Sheet1
    
14. #014          For i = 4 To .Range("A65536").End(xlUp).Row
    
15. #015              If ComboBox1.Text = .Cells(i, 1) Then
    
16. #016                  c = .Cells(i, 255).End(xlToLeft).Column
    
17. #017                  If Application.CountIf(.Range(.Cells(i, 4), .Cells(i, c)), TextBox1) > 0 Then
    
18. #018                      MsgBox "人员姓名重复,请重新输入!", 64, "提示"
    
19. #019                      TextBox1 = ""
    
20. #020                      TextBox1.SetFocus
    
21. #021                      Exit Sub
    
22. #022                  Else
    
23. #023                      .Cells(i, c + 1) = TextBox1
    
24. #024                      ListBox1.AddItem TextBox1
    
25. #025                  End If
    
26. #026              End If
    
27. #027          Next
    
28. #028      End With
    
29. #029      TextBox1.Text = ""
    
30. #030      TextBox1.SetFocus
    
31. #031  End Sub

复制代码

代码解析：
       人员设置窗体中“增加”按钮的单击事件，将输入的人员姓名保存到“资料”表中该人员所在部门的行中。
       第4行到第7行代码，判断是否已选择了所需增加人员的部门。
       第8行到第12行代码，判断是否已输入所增加的人员姓名。
       第15、16行代码，取得该部门在“资料”表中最右边列的列号。
       第17行到第22行代码，判断所增加的人员姓名是否重复。
       第23行代码，将所增加的人员姓名保存到“资料”表中。
       第24行代码，将增加的人员姓名添加到列表框中。
       第29、30行代码，清空文本框以便再次增加部门人员。
       双击窗体上的“删除”按钮，在打开的代码窗口写入下面的代码：

1. #001  Private Sub CommandButton2_Click()
   
2. #002      Dim i As Integer
   
3. #003      Dim c As Integer
   
4. #004      Dim j  As Integer
   
5. #005      If ComboBox1.Text = "" Then
   
6. #006          MsgBox "请先选择一个部门!", 64, "提示"
   
7. #007          Exit Sub
   
8. #008      End If
   
9. #009      If ListBox1.ListIndex < 0 Then
   
10. #010          MsgBox "请选择需删除的人员姓名!", 64, "提示"
    
11. #011          Exit Sub
    
12. #012      End If
    
13. #013      With Sheet1
    
14. #014          If MsgBox("确定要删除" & ListBox1 & "吗?", 36, "警告") = 6 Then
    
15. #015              For i = 4 To .Range("A65536").End(xlUp).Row
    
16. #016                  If ComboBox1.Text = .Cells(i, 1).Value Then
    
17. #017                      c = .Cells(i, 255).End(xlToLeft).Column
    
18. #018                      For j = 4 To c
    
19. #019                          If .Cells(i, j) = ListBox1 Then
    
20. #020                              .Cells(i, j).Delete Shift:=xlToLeft
    
21. #021                          End If
    
22. #022                      Next
    
23. #023                  End If
    
24. #024              Next
    
25. #025              ListBox1.RemoveItem (ListBox1.ListIndex)
    
26. #026          End If
    
27. #027      End With
    
28. #028  End Sub

复制代码

代码解析：
       人员设置窗体中“删除”按钮的单击事件，删除所选部门中的人员姓名。
       第5行到第8行代码，判断是否已选择了部门。
       第9行到第12行代码，判断是否已选择了所需删除的人员。
       第13行到第24行代码，删除该人员所在部门保存在“资料”表中该人员的单元格。
       第25行代码，从列表框中删除该人员。
       设置了使用单位、部门和人员的“资料”表如图所示。