求大神帮忙从工资表里得计件数量分工序表汇总倒工序统计表格中

李松祥

求大神帮忙从工资表里得计件数量分日期分分工单号工序表汇总到工序统计表格中。简单得说就是工序统计表提取想要提取的工单号的工序数量分日期汇总

3190496160

这种问题，非常繁琐，建议上淘宝或者有偿

3190496160

Sub 拆分()
Application.ScreenUpdating = False
Dim d As Object, dc As Object, dic As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
Set dic = CreateObject("scripting.dictionary")
Dim ar As Variant, br As Variant
Application.DisplayAlerts = False
For Each sh In Sheets
    If sh.Index > 2 Then sh.Delete
Next sh
Application.DisplayAlerts = True
With Sheets("桂岭（车工手工）")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:n" & r)
End With
    For i = 3 To UBound(ar)
        If Trim(ar(i, 3)) <> "" Then
            dic(Trim(ar(i, 3))) = ""
        End If
    Next i
    For Each k In dic.keys
        n = 0: y = 5
        dc.RemoveAll: d.RemoveAll
        ReDim cr(1 To UBound(ar), 1 To UBound(ar, 2))
        Sheets("模板").Copy after:=Sheets(Sheets.Count)
        With Sheets(Sheets.Count)
            .Name = k
            br = .Range("a1:z24")
            For i = 5 To UBound(br)
                If Trim(br(i, 3)) <> "" Then
                    If InStr(br(i, 3), "组：") = 0 Then
                        d(Trim(br(i, 3))) = i
                    End If
                End If
            Next i
   
            For i = 3 To UBound(ar)
                If Trim(ar(i, 3)) = k Then
                    n = d(Trim(ar(i, 6)))
                    If n <> "" Then
                        If Not dc.exists(Trim(ar(i, 1))) Then
                            y = y + 4
                            br(n, y) = ar(i, 8)
                            br(2, y) = ar(i, 1)
                            dc(Trim(ar(i, 1))) = y
                        Else
                            m = dc(Trim(ar(i, 1)))
                            br(n, m) = br(n, m) + ar(i, 8)
                        End If
                    End If
                End If
            Next i
            .Range("a1:z24") = br
            .[a1] = "工单号：" & k
            .[b5:b11] = k
            .[b13:b21] = k
            .[b23:b24] = k
        End With
    Next k
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

实在不明白你的意思，仅供参考
10计件工资表.rar (72.67 KB, 下载次数: 21)

2020-11-2 15:20 上传

点击文件名下载附件

李松祥

3190496160 发表于 2020-11-2 15:19
Sub 拆分()
Application.ScreenUpdating = False
Dim d As Object, dc As Object, dic As Object

大神哥，这段代码直接复制，粘贴到表格，还是需要到宏？

李松祥

3190496160 发表于 2020-11-2 15:21
实在不明白你的意思，仅供参考

当天产量还需要统计