急！一年的领料数据要重新弄成一个个领料单，请大神帮助！

桥桥

啊~要疯了，审计要一整年的领料数据重新弄成一个个领料单，请大神帮忙弄个宏，不然几天都处理不完。具体要求写在领料单那张表上，谢谢！

3190496160

说实话，没有什么技术难度，但是，非常繁琐，工作量不小，特别是还得每个月一个工作表，先留个记号吧

桥桥

3190496160 发表于 2021-7-30 12:22
说实话，没有什么技术难度，但是，非常繁琐，工作量不小，特别是还得每个月一个工作表，先留个记号吧

嗯，大侠说得对，工作量不小。

3190496160

Sub 生成领料单()
Application.ScreenUpdating = False
Dim d As Object
Dim ar As Variant
Dim br()
Dim i As Long
Set d = CreateObject("scripting.dictionary")
f = Dir(ThisWorkbook.Path & "\源数据.xls*")
If f = "" Then MsgBox "找不到源数据文件！": End
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f, 0)
ar = wb.Worksheets(1).[a1].CurrentRegion
wb.Close False
For i = 3 To UBound(ar)
    If Trim(ar(i, 1)) <> "" And Trim(ar(i, 7)) <> "" Then
        zf = Trim(ar(i, 1)) & "|" & Trim(ar(i, 7))
        d(zf) = ""
    End If
Next i
Set Rng = Sheets("模板").Rows("1:20")
Set sh = Sheets("领料单")
With sh
    .UsedRange.Clear
    For Each k In d.keys
        n = 0
        ReDim br(1 To UBound(ar), 1 To 7)
        For i = 3 To UBound(ar)
            zf = Trim(ar(i, 1)) & "|" & Trim(ar(i, 7))
            If zf = k Then
                n = n + 1
                rq = ar(i, 1)
                br(n, 1) = n
                For j = 2 To 6
                    br(n, j) = ar(i, j)
                Next j
                br(n, 7) = br(n, 6)
            End If
        Next i
        If n <= 10 Then
            r = .Cells(Rows.Count, 2).End(xlUp).Row + 2
            If r = 3 Then
                r = 1
            Else
                r = r
            End If
            Rng.Copy .Cells(r, 1)
            .Cells(r + 2, 10) = rq
            .Cells(r + 2, 5) = Split(k, "|")(1)
            If r = 1 Then
                .Cells(r + 1, 6) = "YFLL" & Format(rq, "yyyymmdd") & Format(1, "00")
            ElseIf r > 1 Then
                If Val(Format(.Cells(r - 18, 10), "yyyymmdd")) = Val(Format(rq, "yyyymmdd")) Then
                   .Cells(r + 1, 6) = "YFLL" & Format(rq, "yyyymmdd") & Format(Val(Right(.Cells(r - 19, 6), 2)) + 1, "00")
                Else
                     .Cells(r + 1, 6) = "YFLL" & Format(rq, "yyyymmdd") & Format(1, "00")
                End If
            End If
            .Cells(r + 4, 1).Resize(n, UBound(br, 2)) = br
        ElseIf n > 10 Then
            For i = 1 To n Step 10
                r = .Cells(Rows.Count, 2).End(xlUp).Row + 2
                If r = 3 Then
                    r = 1
                Else
                    r = r
                End If
                Rng.Copy .Cells(r, 1)
                .Cells(r + 2, 10) = rq
                .Cells(r + 2, 5) = Split(k, "|")(1)
                If r = 1 Then
                    .Cells(r + 1, 6) = "YFLL" & Format(rq, "yyyymmdd") & Format(1, "00")
                ElseIf r > 1 Then
                    rq_1 = Val(Format(.Cells(r - 18, 10), "yyyymmdd"))
                    rq_2 = Val(Format(rq, "yyyymmdd"))
                    a = Val(Right(.Cells(r - 19, 6), 2))
                    w = Format(Val(Right(.Cells(r - 18, 10), 2)) + 1, "00")
                    If Val(Format(.Cells(r - 18, 10), "yyyymmdd")) = Val(Format(rq, "yyyymmdd")) Then
                       .Cells(r + 1, 6) = "YFLL" & Format(rq, "yyyymmdd") & Format(Val(Right(.Cells(r - 19, 6), 2)) + 1, "00")
                    Else
                         .Cells(r + 1, 6) = "YFLL" & Format(rq, "yyyymmdd") & Format(1, "00")
                    End If
                End If
                xh = r + 3
                For s = i To i + 9
                    xh = xh + 1
                    For j = 1 To 7
                        .Cells(xh, j) = br(s, j)
                    Next j
                Next s
            Next i
        End If
    Next k
End With
Application.ScreenUpdating = True
MsgBox "ok!", 64, "提醒！"
End Sub

3190496160

领料数据.rar (69.81 KB, 下载次数: 30)

2021-7-30 17:30 上传

点击文件名下载附件

3190496160

因为涉及到单元格格式，不可避免的要频繁操作单元格，一年的数据量肯定不小，所以，建议分段运行，

qhcman

为什么套用后领料单只有一条或三条数据，无法以次填满单张表格！

qhcman

3190496160 发表于 2021-7-30 17:31
因为涉及到单元格格式，不可避免的要频繁操作单元格，一年的数据量肯定不小，所以，建议分段运行，

大神  为什么套用后领料单只有一条或三条数据，无法以次填满单张表格！

桥桥

3190496160 发表于 2021-7-30 17:30

谢谢！帮了大忙了！感恩！

桥桥

3190496160 发表于 2021-7-30 17:31
因为涉及到单元格格式，不可避免的要频繁操作单元格，一年的数据量肯定不小，所以，建议分段运行，

大神，还有一个小问题能否帮忙修改一下，就是相同日期不同项目会出现单据编号重复的问题。能否帮忙修改一下代码，让相同日期的单据编号顺加上去。