仓库打印排版

'需求

'每页打印50输出50行(1行标题+49行数据)

'小类和SKU放在A/B列

'标题放在每页第一行

'店号/数量/余量放在C/D/E列,当放不下时空列再放置(G/H/I K/L/M)还不够放时就换页

'统计每个SKU出现的次数

'对数据行用下划线标识

Option Explicit

Sub Print_Detail()

    Dim i&, j&, t&, x&, arr, d As Object, arr_Items, arr_Keys, arr_Temp(), xrr(0 To 10 ^ 4, 1 To 15), arr_Part, Position&, s&, arr_Field

    Application.ScreenUpdating = False

    Cells.Clear

    On Error Resume Next

    arr = Sheets("明细").[a1].CurrentRegion

    Set d = CreateObject("scripting.dictionary")

    For i = 2 To UBound(arr)

        d(arr(i, 1) & "|" & arr(i, 8)) = d(arr(i, 1) & "|" & arr(i, 8)) + 1      '对每个SKU计数

    Next i

    arr_Items = d.Items()

    arr_Keys = d.keys()

    ReDim arr_Temp(1 To 100, 1 To 4)

    For i = 0 To UBound(arr_Items)

        If arr_Items(i) Mod 147 = 0 Then                        '当正好充满列数时

            For j = 1 To arr_Items(i) \ 147

                t = t + 1

                arr_Temp(t, 1) = Split(arr_Keys(i), "|")(0)    '小类

                arr_Temp(t, 2) = Split(arr_Keys(i), "|")(1)    'SKU

                arr_Temp(t, 3) = 147                            '每页数据量

            Next j

        Else

            For j = 1 To arr_Items(i) \ 147

                t = t + 1

                arr_Temp(t, 1) = Split(arr_Keys(i), "|")(0)

                arr_Temp(t, 2) = Split(arr_Keys(i), "|")(1)

                arr_Temp(t, 3) = 147

            Next j

            t = t + 1

            arr_Temp(t, 1) = Split(arr_Keys(i), "|")(0)

            arr_Temp(t, 2) = Split(arr_Keys(i), "|")(1)

            arr_Temp(t, 3) = arr_Items(i) Mod 147

        End If

    Next i

    For i = 1 To t

        If arr_Temp(i, 3) > 49 Then                            '每页数据行数

            arr_Temp(i, 4) = 49

        Else

            arr_Temp(i, 4) = arr_Temp(i, 3)

        End If

    Next i

    For i = 1 To t

        For j = 1 To arr_Temp(i, 4)

            xrr((i - 1) * 50 + j, 1) = arr_Temp(i, 1)

            xrr((i - 1) * 50 + j, 2) = arr_Temp(i, 2)

        Next j

    Next i

    arr_Part = Application.Index(xrr, , 2)

    Dim s1, s2, yrr(1 To 200, 1 To 3)

    For i = 2 To UBound(arr)

        Position = Application.Match(arr(i, 8), arr_Part, 0)

        s = s + 1

        xrr(Position + ((s - 1) \ 147) * 50 + (s - 1) Mod 49 - 1, ((s - 1) \ 49 Mod 3) * 4 + 3) = arr(i, 12)

        xrr(Position + ((s - 1) \ 147) * 50 + (s - 1) Mod 49 - 1, ((s - 1) \ 49 Mod 3) * 4 + 4) = arr(i, 10)

        xrr(Position + ((s - 1) \ 147) * 50 + (s - 1) Mod 49 - 1, ((s - 1) \ 49 Mod 3) * 4 + 5) = arr(i, 11)

        If s = arr_Items(x) Then s = 0: x = x + 1

    Next i

    arr_Field = [{"小类","SKU","店号","数量","余量"}]

    For i = 1 To t

        If xrr((i - 1) * 50 + 1, 1) <> "" Then

            xrr((i - 1) * 50, 1) = arr_Field(1)

            xrr((i - 1) * 50, 2) = arr_Field(2)

        End If

        For j = 1 To 3

            If xrr((i - 1) * 50 + 1, j * 4 - 1) <> "" Then

                xrr((i - 1) * 50, j * 4 - 1) = arr_Field(3)

                xrr((i - 1) * 50, j * 4) = arr_Field(4)

                xrr((i - 1) * 50, j * 4 + 1) = arr_Field(5)

            End If

        Next j

    Next i

    d.RemoveAll

    For i = 2 To UBound(arr)

        d(arr(i, 8)) = d(arr(i, 8)) + arr(i, 10)

    Next i

    For i = 2 To UBound(xrr)

        If d.exists(xrr(i, 2)) Then

            xrr(i, 15) = d(xrr(i, 2))

            d.Remove xrr(i, 2)

        End If

    Next i

    [a1].Resize(t * 50, UBound(xrr, 2)) = xrr

    For i = 1 To t

        For j = 1 To 3

            If Cells((i - 1) * 50 + 1, j * 4 - 1) <> "" Then Cells((i - 1) * 50 + 1, j * 4 - 1).CurrentRegion.Borders(xlInsideHorizontal).LineStyle = xlDash

        Next j

    Next i

    Columns("A:O").HorizontalAlignment = xlCenter          '居中

    Application.ScreenUpdating = True

End Sub