1.在这里主要以一个人员薪酬表为例子,做简单的增删改等操作,以及快速生成工资条,窗口示例如下
2.数据表信息如下
3.生成的工资表如下
4.详细代码如下
'添加员工信息
Private Sub CommandButton1_Click()
Dim i
Dim w1
Set w1 = Worksheets(1)
i = 2
While w1.Cells(i, 1) <> ""
i = i + 1
Wend
If TextBox1 = "" Then
MsgBox "工号不能为空!", vbOKOnly
'将对应的信息填写在工作表中
End If
If TextBox1 <> "" Then
w1.Cells(i, 1) = TextBox1.Text
w1.Cells(i, 2) = TextBox2.Text
w1.Cells(i, 3) = ListBox1.Text
w1.Cells(i, 4) = ListBox2.Text
w1.Cells(i, 5) = TextBox3.Text
w1.Cells(i, 6) = TextBox4.Text
End If
MsgBox "添加完成", vbOKOnly
End Sub
'删除员工信息
Private Sub CommandButton2_Click()
Dim i
Dim w1
Set w1 = Worksheets(1)
i = 2
While w1.Cells(i, 1) <> TextBox1.Text And w1.Cells(i, 1) <> ""
i = i + 1
Wend
'将对应的信息显示在对应的文本框中
If w1.Cells(i, 1) = TextBox1.Text Then
TextBox2.Text = w1.Cells(i, 2)
ListBox1.Text = w1.Cells(i, 3)
ListBox2.Text = w1.Cells(i, 4)
TextBox3.Text = w1.Cells(i, 5)
TextBox4.Text = w1.Cells(i, 6)
respose = MsgBox("确定删除吗?", vbOKCancel)
If respose = vbOK Then
Range("A" & i, "I" & i).Select
Selection.Delete Shift:=xlUp
MsgBox "删除完成", vbOKOnly
End If
If respose = vbCancel Then
w1.Cells(i, 1) = TextBox1.Text
w1.Cells(i, 2) = TextBox2.Text
w1.Cells(i, 3) = ListBox1.Text
w1.Cells(i, 4) = ListBox2.Text
w1.Cells(i, 5) = TextBox3.Text
w1.Cells(i, 6) = TextBox4.Text
End If
End If
If w1.Cells(i, 1) <> TextBox1.Text Then
MsgBox "未找到该工号,请确认工号是否有误!"
End If
End Sub
'修改员工信息
Private Sub CommandButton3_Click()
Dim i
Dim w1
Set w1 = Worksheets(1)
i = 2
While w1.Cells(i, 1) <> TextBox1.Text And w1.Cells(i, 1) <> ""
i = i + 1
Wend
If w1.Cells(i, 1) = TextBox1.Text Then
TextBox2.Text = w1.Cells(i, 2)
ListBox1.Text = w1.Cells(i, 3)
ListBox2.Text = w1.Cells(i, 4)
TextBox3.Text = w1.Cells(i, 5)
TextBox4.Text = w1.Cells(i, 6)
respose = MsgBox("确定修改吗?", vbOKCancel)
If respose = vbOK Then
w1.Cells(i, 1) = TextBox1.Text
w1.Cells(i, 2) = TextBox2.Text
w1.Cells(i, 3) = ListBox1.Text
w1.Cells(i, 4) = ListBox2.Text
w1.Cells(i, 5) = TextBox3.Text
w1.Cells(i, 6) = TextBox4.Text
MsgBox "修改完成", vbOKOnly
End If
If respose = vbCancel Then
End If
End If
If w1.Cells(i, 1) <> TextBox1.Text Then
MsgBox "未找到该工号,请确认工号是否有误!"
End If
End Sub
'一键生成工资表
Private Sub CommandButton4_Click()
Dim i, j
Dim w1, w3
Set w1 = Worksheets(1)
Set w3 = Worksheets(3)
i = 1
j = 1
While w1.Cells(i, 1) <> ""
i = i + 1
Wend
While w1.Cells(1, j) <> ""
j = j + 1
Wend
'将数据复制到指定工作表
Sheets("Sheet1").Activate
Sheets("Sheet1").Range(Cells(1, 1), Cells(i, j)).Select
Selection.Copy
Sheets("Sheet3").Select
Range("A1").Select
ActiveSheet.Paste
i = 2
'插入标题行
While w3.Cells(i, 1) <> ""
If (i Mod 2) = 1 Then
w3.Range(Cells(1, 1), Cells(1, j)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Activate
Sheets("Sheet3").Range("A" & i).Select
Selection.Insert Shift:=xlDown
End If
i = i + 1
Wend
i = 2
'插入空白行
While Cells(i, 1) <> ""
If (i Mod 3) = 0 Then
Sheets("Sheet3").Activate
Sheets("Sheet3").Range("A" & i).Select
Application.CutCopyMode = False
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
End If
i = i + 1
Wend
End Sub