我又来提出新的要求了！

边缘码农 · 发表于 2024-6-27 12:39

代码2：第4部分

'--------------------------------------
' 计算：产值
For I = KSRow To JSRow
NowGxnr = MyArr(I, NrCol) '取出当前工作表当前行的工序内容描述：工序名称
Jsgx = False
If InStr(NowGxnr, "计时/") > 0 Then Jsgx = True
If Jsgx Then
' 是计时工序，此时产量列一定不是合并单元格，产值=时薪*工时
For X = 1 To UBound(RsArr)
If RsArr(X, getNum(RsArr, "姓名")) = MyArr(I, XmCol) Then
NowSX = RsArr(X, getNum(RsArr, "时薪")) '取得当前行员工的时薪
Exit For
End If
Next
' 计算计时工序的产值：时薪X工时，并回写
.Cells(I, CzCol) = Application.Round(NowSX * MyArr(I, GsCol), Xsws)
Else
'-----------------------------------------------
' 计算说明
' 不是计时工序，按照计件计算产值
'
' 当：产量单元格不是合并单元格时，属于单人独自完成，产值＝"工时工价表"中工序名称对应的工价*产量
'
' 当：产量是合并单元格时，则表示是多人以工作组的方式完成，则需要先核算出总产值：
' 在产量合并单元格所占的行数和款号+工序所在列交叉的区域中，剔除重复的款号+工序名称；
' 去重后的工序对应的工价*产量之和，是工作组总产值
' 个人产值=总产值/工作小组人数。
' 工作小组的人数=合并单元格的行数
'-----------------------------------------------
' 将产量单元格赋给对象变量
Set NowRng = .Cells(I, ClCol)
TotalRow = 1
' 取得合并单元格的行数
If NowRng.MergeCells Then
' 是合并单元格，按照合并单元格的行数循环处理
TotalRow = NowRng.MergeArea.Rows.Count
End If
' 按照产量合并单元格的行数进行循环，剔除款号+工序名称的重复项
GxDict.RemoveAll ' 清空字典
TotalCZ = 0 '工作组产值合计变量赋初值
NowCL = NowRng.Value '取出当前工作表当前行的产量
For J = 1 To TotalRow
NowKh = MyArr(I + J - 1, KhCol) '取出当前款号
NowGxnr = MyArr(I + J - 1, NrCol) '取出当前工作表当前行的工序内容描述：工序名称
'根据款号、工作内容描述两个条件取得工价
GxKey = NowKh & NowGxnr
If Not GxDict.Exists(GxKey) Then
' 当前Key的值不在字典中
' 寻找当前Key对应的工价
NowGJ = 0
For X = 1 To UBound(GsArr) ' 按照工时工价表数组的成员数进行循环
If GsArr(X, getNum(GsArr, "款号")) = NowKh Then
' 当前工作表当前行款号=工时工价表中的款号
If GsArr(X, getNum(GsArr, "工序名称")) = NowGxnr Then
' 当前工作表当前行工序名称=工时工价表中的工序名称
' 符合两个条件，取得当期工价
NowGJ = GsArr(X, getNum(GsArr, "工价"))
Exit For
End If
End If
Next
' 将相关信息写入数组：款号、工序名称、工价、产量
GxDict.Add GxKey, GxKey
'Array(NowKh, NowGxnr, NowGJ, NowCL)
TotalCZ = TotalCZ + NowGJ * NowCL
End If
Next
For J = 1 To TotalRow
If Not Jsgx Then
' 当前不是计时工序
If TotalCZ = 0 Then
' 当前产值为0，则：当前工作表中的款号、工序名称和工时工价表中的不一致
.Cells(I + J - 1, CzCol) = "有问题"
ErrSL = ErrSL + 1
' 错误信息单元格着底色
With .Cells(I + J - 1, CzCol).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Else
.Cells(I + J - 1, CzCol) = Application.Round(TotalCZ / TotalRow, Xsws)
End If
End If
Next
I = I + J - 2
End If
Next
'--------------------------------------
' 计算：工资
' 工资：等于人事总表中该员工对应的时薪*工时
For I = KSRow To JSRow
For X = 1 To UBound(RsArr)
If RsArr(X, getNum(RsArr, "姓名")) = MyArr(I, XmCol) Then
NowSX = RsArr(X, getNum(RsArr, "时薪")) '取得当前行员工的时薪
Exit For
End If
Next
.Cells(I, GzCol) = Application.Round(NowSX * MyArr(I, GsCol), Xsws)
Next
'--------------------------------------
' 计算：实发
' 实发：如果工作内容前面有“计时/”字样，工资就等于“人事总表”中该员工对应的时薪*工时；否则表示该员工是计件，工资就等于产值
For I = KSRow To JSRow
NowGxnr = MyArr(I, NrCol) '取出当前工作表当前行的工序内容描述：工序名称
Jsgx = False
If InStr(NowGxnr, "计时/") > 0 Then Jsgx = True
If Jsgx Then
' 是计时工序，=工资
.Cells(I, SfCol) = .Cells(I, GzCol)
Else
' 不是计时工序，=产值
.Cells(I, SfCol) = .Cells(I, CzCol)
If .Cells(I, SfCol) = "有问题" Then
ErrSL = ErrSL + 1
' 错误信息单元格着底色
With .Cells(I, SfCol).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
End If
End If
Next
'--------------------------------------
' 计算：绩效
' 绩效：绩效＝实发-工资
On Error Resume Next ' 开始错误处理，防止公式错误导致宏停止
For I = KSRow To JSRow
.Cells(I, JxCol) = .Cells(I, SfCol) - .Cells(I, GzCol)
' 检查错误号，如果不为0，则公式出错
If Err.Number <> 0 Then
' 公式错误处理
.Cells(I, JxCol) = "有问题"
ErrSL = ErrSL + 1
' 错误信息单元格着底色
With .Cells(I, JxCol).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Err.Clear ' 清除错误
End If
Next
'--------------------------------------
' 计算结束
End With
ErrXX = "计算完成。 "
If ErrSL > 0 Then
ErrXX = ErrXX & Chr(10) & Chr(10) & "有 " & ErrSL & " 处错误，请修正相关数据后，重新执行刷新操作。"
End If
MsgBox ErrXX, vbInformation, "计算结果"
End Sub

复制代码

边缘码农 · 发表于 2024-6-27 12:40

danhanqing 发表于 2024-6-27 11:09
哦！那我听您安排吧！再次感谢！

已贴。

代码需要审核，可能要过一段时间。

边缘码农 · 发表于 2024-6-27 12:43

代码2 共分解成4部分，依次复制过去。

danhanqing · 发表于 2024-6-27 14:45

边缘码农发表于 2024-6-27 12:43
代码2 共分解成4部分，依次复制过去。

2024年7月份明声日报表.rar (77.58 KB, 下载次数: 1)

执行核算是出错了，没检查出问题出在哪里，请老师看看！感谢！

边缘码农 · 发表于 2024-6-27 14:53

danhanqing 发表于 2024-6-27 14:45
执行核算是出错了，没检查出问题出在哪里，请老师看看！感谢！

我在46楼写的那些看了没有？第2行和第9行中的标题不能有空格。出问题的是第9行的“姓名”，有空格。

现在的代码没有太多的错误检测，出现问题，一般就是数据的问题。

比如这个问题：在代码中可以查看出错行中变量的值

xmcol（姓名列）的值为0，是错误的。

边缘码农 · 发表于 2024-6-27 14:54

代码不是很完善，比如工时工价表的列次顺序就不能动。

danhanqing · 发表于 2024-6-27 15:06

边缘码农发表于 2024-6-27 14:53
我在46楼写的那些看了没有？第2行和第9行中的标题不能有空格。出问题的是第9行的“姓名”，有空格。

...

我也检查了空格问题，还是没检查仔细，居然还有一个半角空格存在

danhanqing · 发表于 2024-6-27 15:06

边缘码农发表于 2024-6-27 14:54
代码不是很完善，比如工时工价表的列次顺序就不能动。

非常详细了！那个列序不准她们动就是了。

边缘码农 · 发表于 2024-6-27 15:21

danhanqing 发表于 2024-6-27 15:06
我也检查了空格问题，还是没检查仔细，居然还有一个半角空格存在

这个空格被复合框挡住了。

		自动登录	找回密码
密码			免费注册

[求助] 我又来提出新的要求了！

评分