|
发表于 2016-10-2 20:38
|
显示全部楼层
本楼为最佳答案
先生成,再打印,再删除。
- Sub 按村组生成()
- Set d = CreateObject("scripting.dictionary")
- arr = [a1].CurrentRegion
- For i = 5 To UBound(arr)
- zu = arr(i, 3)
- If zu <> "" Then d(zu) = d(zu) & "," & i
- Next
-
- Application.ScreenUpdating = False
- rmax = 33 '每张表最大人数
- For Each zu In d.keys
- xrr = Split(d(zu), ",")
- rs = UBound(xrr) '组的人数
- n = (rs - 0.1) \ rmax + 1
- For pg = 1 To n
- Sheets(2).Copy after:=Sheets(Sheets.Count)
- With ActiveSheet
- .Name = zu & pg
- ReDim brr(1 To rmax, 1 To UBound(arr, 2))
- s = (pg - 1) * 33 '起始位置
- For r = 1 To rmax
- If r + s <= rs Then
- i = xrr(r + s)
- For j = 1 To UBound(arr, 2)
- brr(r, j) = arr(i, j)
- Next
- End If
- Next
- .[a5].Resize(rmax, UBound(brr, 2)) = brr
- End With
- Next
- Next
- Sheets(1).Activate
- Application.ScreenUpdating = True
- End Sub
- Sub 清除()
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- For Each sh In Worksheets
- If sh.Index > 2 Then sh.Delete
- Next
- Application.DisplayAlerts = True
- Application.ScreenUpdating = True
- End Sub
- Sub 打印()
- For Each sh In Worksheets
- If sh.Index > 2 Then sh.PrintPreview
- 'If sh.Index > 2 Then sh.PrintOut
- Next
- End Sub
复制代码 |
|