d12Gsm7H.rar
(15.25 KB, 下载次数: 40)
基本上成功,有一点点毛病。最后一个客户的"温馨提示……”需要手工插入分业符
Sub 分页() Dim i&, j& Cells.Select ActiveSheet.ResetAllPageBreaks For i = 1 To 60000 If Cells(i, 2) = "" Then Exit Sub If Cells(i, 1) = "" Then Cells(i, 5).Value = "温馨提示:请收到后回复邮件.谢谢" Cells(i, 7).Activate ActiveSheet.HPageBreaks.Add Cells(i + 1, 7) End If Next i With ActiveSheet.PageSetup .PrintTitleRows = "$1:$1" .PrintTitleColumns = "" End With ActiveWorkbook.Save End Sub Sub 排序汇总() Range("A1").Select Range("A1:D12").Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range( _ "A2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase _ :=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:= _ xlSortNormal, DataOption2:=xlSortNormal Selection.Subtotal GroupBy:=2, Function:=xlCount, TotalList:=Array(4), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True End Sub |