VBA-窗体程序,制作一个简单的窗口来进行数据的增删改

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

 



  • 14
    点赞
  • 124
    收藏
    觉得还不错? 一键收藏
  • 5
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论 5
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值