求助各位大神，用vba自动计算工资

zxsea_7426

kjshlhp 发表于 2023-4-26 20:22
单价的问题没有解决，件数1的，单价应该是2.4元，测试结果单价是0；件数是3.1的，单价应该是3.3元，测试 ...

仔细查了下，原来是定义类型错了，所以结果也跟着错了。[一开始理解错了， 计件原来理解成整数件了，没有想到出来了带小数点的件数。所以跟着定义类型也错了，当然结果就....]
原来代码定义成整型了，所以出现了小数点后面的不正确了

kjshlhp

心的启点 发表于 2023-4-27 09:22
修改过了试下。你这加了一行提取空值为0什么意思？

非常感谢！

kjshlhp

a18b88 发表于 2023-4-27 10:24
前面附件有点纰漏，现重复，附件：

您的表也很好用，只是我们这里要求每个人一个工资表，还要公示。

kjshlhp

zxsea_7426 发表于 2023-4-26 20:32
加了一行，提取空值加为0

好厉害，工资表里加列减列也能计算

a18b88

kjshlhp 发表于 2023-4-28 21:16
您的表也很好用，只是我们这里要求每个人一个工资表，还要公示。

通过筛选不就可以生成每个人的明细工资表了吗.附件： 工资及计算加公示表.rar (39.66 KB, 下载次数: 2)

2023-5-6 12:18 上传

点击文件名下载附件

a18b88

kjshlhp 发表于 2023-4-28 21:16
您的表也很好用，只是我们这里要求每个人一个工资表，还要公示。

按你的要求加了公示表，附件： 工资及计算加公示表.rar (39.66 KB, 下载次数: 4)

2023-5-6 12:19 上传

点击文件名下载附件

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     Dim d As Object
   
5.     Dim reg As New RegExp
   
6.     Set d = CreateObject("scripting.dictionary")
   
7.     With reg
   
8.         .Global = True
   
9.         .Pattern = "(\d+\.)?\d+"
   
10.     End With
    
11.     With Worksheets("工资计算基数")
    
12.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
13.         arr = .Range("a3:b" & r)
    
14.         ReDim brr(1 To UBound(arr), 1 To 2)
    
15.         For i = 1 To UBound(arr)
    
16.             Set mh = reg.Execute(arr(i, 1))
    
17.             If mh.Count = 1 Then
    
18.                 brr(i, 1) = Val(mh(0))
    
19.             Else
    
20.                 brr(i, 1) = Val(mh(1))
    
21.             End If
    
22.             brr(i, 2) = arr(i, 2)
    
23.         Next
    
24.         brr(UBound(brr), 1) = 10 ^ 8
    
25.     End With
    
26.     For Each ws In Worksheets
    
27.         If ws.Name <> "汇总表" And ws.Name <> "工资计算基数" Then
    
28.             With ws
    
29.                 r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
30.                 c = .Cells(1, .Columns.Count).End(xlToLeft).Column
    
31.                 arr = .Range("a1").Resize(r, c)
    
32.                 s = 0
    
33.                 For i = 2 To UBound(arr)
    
34.                     arr(i, UBound(arr, 2)) = Empty
    
35.                     For j = 2 To UBound(arr, 2) - 3 Step 3
    
36.                         arr(i, j + 1) = Empty
    
37.                         For k = 1 To UBound(brr)
    
38.                             If arr(i, j) <= brr(k, 1) Then
    
39.                                 arr(i, j + 1) = brr(k, 2)
    
40.                                 Exit For
    
41.                             End If
    
42.                         Next
    
43.                         arr(i, UBound(arr, 2)) = arr(i, UBound(arr, 2)) + arr(i, j + 1)
    
44.                     Next
    
45.                     s = s + arr(i, UBound(arr, 2))
    
46.                 Next
    
47.                 d(ws.Name) = s
    
48.                 .Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
    
49.             End With
    
50.         End If
    
51.     Next
    
52.     With Worksheets("汇总表")
    
53.         .UsedRange.Offset(1, 0).Clear
    
54.         With .Range("a2").Resize(d.Count, 2)
    
55.             .Value = Application.Transpose(Array(d.keys, d.items))
    
56.             .Borders.LineStyle = xlContinuous
    
57.             .HorizontalAlignment = xlCenter
    
58.             .VerticalAlignment = xlCenter
    
59.         End With
    
60.     End With
    
61. End Sub
    

复制代码

chxw68

闲来无事练练手。

kjshlhp

chxw68 发表于 2023-4-29 11:03
闲来无事练练手。

试了，很好用。就是修改工资计算基数的单价后，明细表中单价随着变动了，但是金额没有变化。