'需求
'每页打印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
网友评论