|
发表于 2021-10-25 22:59
|
显示全部楼层
本楼为最佳答案
- Sub 打印清单()
- Dim ARR, BRR(), D, MAXROW, STARTROW, ENDROW, I As Long, J As Long, K, L As Byte, M, N
- MAXROW = Sheets("销售明细").Range("A65536").End(xlUp).Row
- ARR = Sheets("销售明细").Range("A3:Q" & MAXROW)
- ReDim BRR(1 To 12, 1 To 10)
- J = 1
- Set D = CreateObject("SCRIPTING.DICTIONARY")
- For I = 1 To UBound(ARR)
- If Not D.EXISTS(ARR(I, 1)) Then
- D(ARR(I, 1)) = J
- J = J + 1
- Else
- End If
- Next
- Range("D3").ClearContents
- Range("H3").ClearContents
- Range("K3").ClearContents
- Range("C5:L16").ClearContents
- For Each K In D.KEYS
- Range("H3").Value = K
- M = Application.Match(K, Sheets("销售明细").Range("A3:A" & MAXROW), 0)
- Range("D3").Value = ARR(M, 4)
- Range("K3").Value = ARR(M, 6)
- For L = 1 To Application.CountIf(Sheets("销售明细").Range("A3:A" & MAXROW), K)
- BRR(L, 1) = ARR(M - 1 + L, 7)
- BRR(L, 2) = ARR(M - 1 + L, 10)
- BRR(L, 3) = ARR(M - 1 + L, 8)
- BRR(L, 4) = ARR(M - 1 + L, 9)
- BRR(L, 5) = ARR(M - 1 + L, 11)
- BRR(L, 6) = ARR(M - 1 + L, 12)
- BRR(L, 7) = ARR(M - 1 + L, 13)
- BRR(L, 8) = ARR(M - 1 + L, 14)
- BRR(L, 9) = ARR(M - 1 + L, 16)
- BRR(L, 10) = ARR(M - 1 + L, 17)
- Next L
- Range("C5").Resize(12, 10) = BRR
- ActiveSheet.PrintOut
- Range("D3").ClearContents
- Range("H3").ClearContents
- Range("K3").ClearContents
- Range("C5:L16").ClearContents
- Erase BRR()
- ReDim BRR(1 To 12, 1 To 10)
- Next
- MsgBox "已分类并打印完成"
- End Sub
复制代码
一个多月过去了。估计你都忘记这个了。一个很好的练习题。家里电脑没有打印机。测试了一下,应该是满足你的要求的。 |
|