EXCEL分列打印.doc

Sub zldccmx() Application.ScreenUpdating = False Application.DisplayAlerts = False Sheet2.Activate Range(A2:F5).Select Range(Selection, Selection.End(xlDown).Select Selection.Sort Key1:=Range(A3), Order1:=xlAscending, Key2:=Range(B3) _ , Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _ False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:= _ xlSortNormal, DataOption2:=xlSortNormal s_s = 1 Set r = Sheet2.Range(a3:a & a65536.End(xlUp).Row) Set dic = CreateObject(scripting.dictionary) For Each c In r If Not dic.exists(c.Value) Then dic.Add c.Value, st_h = Application.Match(c, Range(A3:A2104), 0) + 2 e_h = Application.Match(c, Range(A3:A2104), 1) + 2 sl = e_h - st_h + 1 If s_s = 1 Then On Error Resume Next Sheets.Add: ActiveSheet.Name = 报表 If Err.Number 0 Then ActiveSheet.Delete: Sheets(报表).Cells.Delete: Err.Clear On Error GoTo 0 With Sheets(报表) .Range(.Cells(3, 1), .Cells(3, 18).ColumnWidth = Array(3, 7, 7, 6, 6, 7, 3, 7, 7, 6, 6, 7, 3, 7, 7, 6, 6, 7) .a1:r1.Merge: .a2:b2.Merge: .c2:e2.Merge: .f2:g2.Merge: .h2:j2.Merge: .m2:n2.Merge: .o2:r2.Merge .a1 = 浮动人助金发放花名册: .a2 = 班级：: .f2 = 人数：: .m2 = 合计金额: .a1.Font.Size = 24 .a3:f3 = Array(序号, 姓名, 月份, 月标准, 金额, 签名) .g3:l3.Value = .a3:f3.Value: .m3:r3.Value = .a3:f3.Value: .Cells.HorizontalAlignment = xlCenter hhh = Round(sl 3 + 0.9999) .Cells(2, 3) = c.Value .Cells(2, 8) = sl & 人 .Cells(2, 15) = =sum(F4:F & hhh + 4 - 1 & ,M & 4 & :M & hhh + 4 - 1 & ,T & 4 & :T & hhh + 4 - 1 & ) For j = 1 To hhh .Range(.Cells(j + 3, 1), .Cells(j + 3, 5).Value = Sheets(数据).Range(Cells(st_h + j - 1, 2), Cells(st_h + j - 1, 6).Value .Range(.Cells(j + 3, 7), .Cells(j + 3, 11).Value = Sheets(数据).Range(Cells(st_h + j - 1 + hhh, 2), Cells(st_h + j - 1 + hhh, 6).Value .Range(.Cells(j + 3, 13), .Cells(j + 3, 17).Value = IIf(st_h + j + 2 * hhh = e_h, Sheets(数据).Range(Cells(st_h + j - 1 + 2 * hhh, 2), Cells(st_h + j - 1 + 2 * hhh, 6).Value, ) Next j .Range(.Cells(3, 1), .Cells(hhh + 3, 18).Borders.LineStyle = xlContinuous .Cells(hhh + 4, 4) = 制表人：: .Cells(hhh + 4, 13) = 审核人（班主任）： .Cells(hhh + 4, 15) = Application.VLookup(.C2.Value, Sheets(班主任名单).Range(A:B), 2, 0) End With s_s = 2 Else With Sheets(报表) endrow = .d65536.End(xlUp).Row + 1 .Rows(1:3).Copy .Rows(endrow).Insert shift:=xlDown .Rows(endrow).PageBreak = xlPageBreakManual hhh = Round(sl 3 + 0.9999) .Cells(endrow + 1, 3) = c.Value .Cells(endrow + 1, 8) = sl & 人 .Cells(endrow + 1, 15) = =sum(F & endrow + 3 & :F & endrow + hhh + 3 - 1 & ,M & endrow + 3 & :M & endrow + hhh + 3 - 1 & ,T & endrow + 3 & :T & endrow + hhh + 3 - 1 & ) For j = 1 To hhh .Range(.Cells(j + endrow + 2, 1), .Cells(j + endrow + 2, 5).Value = Sheets(数据).Range(Cells(st_h + j - 1, 2), Cells(st_h + j - 1, 6).Value .Range(.Cells(j + endrow + 2, 7), .Cells(j + endrow + 2, 11).Value = Sheets(数据).Range(Cells(st_h + j - 1 + hhh, 2), Cells(st_h + j - 1 + hhh, 6).Value .Range(.Cells(j + endrow + 2, 13), .Cells(j + endrow + 2, 17).Value = IIf(st_h + j + 2 * hhh = e_h, Sheets(数据).Range(Cells(st_h + j - 1 + 2 * hhh, 2), Cells(st_h + j - 1 + 2 * hhh, 6).Value, ) Next j .Range(.Cells(endrow + 2, 1), .Cells(hhh + 2 + endrow, 18).Borders.LineStyle = xlContinuous .Cells(hhh + 3 + endrow, 4) = 制表人：: .Cells(hhh + endrow + 3, 13) = 审核人（班主任）： .Cells(hhh + 3 + endrow, 15) = Application.VLookup(.Cells(endrow + 1, 3).Value, Sheets(班主任名单).Range