2024年04月26日
再次设计制作工资管理系统，相对第一个有了些许进步，自动计算方法都进行了优化设计。
从分表录入方式集成到一个Form窗体录入，不仅数据录入方便了许多，而且出错率也降低了。
基本构架：
其中，还有些没有做完成的部分，没有罗列出来。
初次使用，要对人员信息进行录入。可将人员信息保存为模板，以后就只做少许更改即可完成工资制作。
以前，财务做工资表，要一个上午，甚至几天才能完成工资表制作。
我就不明白了，输入几个数据就这么难吗？
问过之后才发现，的确费时费力，原来每次都要面对宏大的数据表格逐个添加。
怎么理解好呢！我也不好解释什么。
这种方法，我认为就一个字 -- 笨。
Excel这么好用的工具都被糟蹋了。
本来5分钟可以完成的工作，为什么要半天来做，有必要吗？
或许对一些人来讲，真的有必要。
不是必要而没有好办法。
于是，经一番周折，做好工资管理系统。
然而，没什么用。
一些人，就是习惯笨笨的办法，要想让她变得轻松，还真不是一个简单的事情。
不过从另一个角度来考虑，或许是此应用非人之所用吧！
这也无所谓。
此工资管理操作需要重点注意一点：
初次使用，首先对人员信息进行设置，这一步很关键，因为此后的所有计算都以人员编号为依据。
输入方面也做窗体化设计，简单操作几下把必要的姓名和入职年份输入就可以了。
当然了，也包括一些系数、保险公积金等相对固定的数据，初次要进行输入。
保存时可以选择保存为模板，下次做工资就直接引用模板数据，然后修改变化项就可以了。
简化了许多重复性数据录入工作。
每个月的变化量是必须要手动录入的，不变量可以作为模板数据进行保存。
Private Sub CommandButton1_Click()
'''''''''' 添加信息 ''''''''''''''''
On Error Resume Next
Application.ScreenUpdating = False
Dim w As Worksheet, s As Worksheet
Set w = ThisWorkbook.Worksheets("工资表")
w.Activate
Set s = ThisWorkbook.Worksheets("个人设置")
Dim iRow As Integer, iCol As Integer
Dim R As Range, Rw As Range, Rv As Range
iRow = w.Range("A65535").End(xlUp).Row
iCol = w.Range("A1").End(xlToRight).Column
Dim inR As Range
Dim cArr()
ReDim cArr(1 To iCol)
Dim cObj As Object
Dim moban As Boolean, Tdate As Date
For Each cObj In Me.Controls
If TypeName(cObj) = "ComboBox" Then
cArr(VBA.CInt(VBA.Replace(cObj.Name, "C", "", 1))) = cObj.Value
End If
If TypeName(cObj) = "CheckBox" And cObj.Name = "che" Then
moban = cObj.Value
End If
If TypeName(cObj) = "TextBox" And cObj.Name = "Dat" Then
If Not VBA.IsDate(cObj.Value) Then MsgBox "入职日期格式不正确", vbInformation, "提示": Exit Sub
If cObj.Value = "0:00:00" Then MsgBox "没有设置入职日期！", vbInformation, "提示": Exit Sub
If VBA.IsDate(cObj.Value) Then
Tdate = VBA.CDate(cObj.Value)
Else
Tdate = "1900/01/01"
End If
End If
Next cObj
cArr(1) = "=row()-1"
'''''''''''''''''' 添加数据
Set Rw = w.Range("C2:C" & iRow)
Dim Ron As Boolean
Ron = False
For Each R In Rw
If R.Value = cArr(3) Then ''''''''''' 信息已经找到修改
Set Rv = w.Range(Cells(R.Row, 1), Cells(R.Row, iCol))
cArr(16) = "=sum(F" & R.Row & ":O" & R.Row & ")" ''''应发工资赋值
cArr(22) = "=P" & R.Row & "-sum(Q" & R.Row & ":u" & R.Row & ")" ''''实发工资赋值
Rv = cArr
Ron = True
End If
Next R
If Not Ron Then '''''''''''没有找到新增信息
Dim Ri As Integer
Ri = 2
w.Rows(Ri).Insert
Set inR = w.Range(Cells(2, 1), Cells(2, iCol))
cArr(16) = "=sum(F" & Ri & ":O" & Ri & ")" ''''应发工资赋值
cArr(22) = "=P" & Ri & "-sum(Q" & Ri & ":u" & Ri & ")" ''''实发工资赋值
inR = cArr
With inR
.Borders.LineStyle = 1
.Interior.Color = RGB(235, 235, 235)
End With
End If
ThisWorkbook.Save
End Sub
代码实在太多，这里随便截取了一段，每个表格里都有不同的代码，如果对vba不太熟悉，假如有一点小问题，可能就是个大麻烦。
建议，工作当中还了解一点vba知识比较好。
文/江觅
如需要索取源码下载，请关注江觅，私信留言，获取下载链接。