一个同学让我帮下他的忙，写一个能生成工资单的Excel宏，从工资明细表中抽取相关数据，生成简易明了的工资单，尝试了一下，代码如下，仅作为记录：
Sub 工资条计算() 'Sheet名称 Dim DataSource As String Dim Target As String Dim Tpl As String Dim TableHeaderPos As Integer Dim EmptyCol As Integer Dim DataStartRow As Integer Dim MaxColCounts As Integer DataSource = "汇总明细" Target = "宏工资条" Tpl = "工资表1" TableHeaderPos = 4 DataStartRow = TableHeaderPos + 1 MaxColCounts = 32 '数据源中最大的横向宽度 MaxColTplCounts = 16 '生成工资表中的最大横向宽度 '收集工资单目标表头 Dim TargetTableHeader(1 To 100) As String Dim Temp As Integer Temp = 1 Do If (Worksheets(Tpl).Cells(1, Temp) = "" And Temp = MaxColTplCounts) Then Exit Do TargetTableHeader(Temp) = Worksheets(Tpl).Cells(1, Temp) Temp = Temp + 1 Loop Temp = 1 '得到总共的数据条数 Dim AllDataCounts As Integer Do If (Worksheets(DataSource).Range("A" & Temp) = "") Then Exit Do Temp = Temp + 1 Loop AllDataCounts = Temp - TableHeaderPos - 1 '得到当前月份，工资单是上一个月 Dim NowMonth As String Dim TableMonth As Integer NowMonth = Format(Now, "m") TableMonth = CInt(NowMonth) - 1 '开始填充数据 '外层循环，行数，Y Dim TargetDataStartRow As Integer Dim Cookie As Integer Cookie = 1 TargetDataStartRow = 5 '默认从第5行开始 For Y = TargetDataStartRow To (TargetDataStartRow + AllDataCounts - 1) '内层循环，列数，X For X = 1 To (MaxColTplCounts - 1) '写入表头 Worksheets(Target).Cells(Y + Cookie - 1, X) = TargetTableHeader(X) '调整表头样式 Worksheets(Target).Cells(Y + Cookie - 1, X).Select Selection.Font.Size = 10 '写入数据 '月份 If (X = 1) Then Worksheets(Target).Cells(Y + Cookie, X) = TableMonth '姓名 If (X = 2 Or X = 3) Then Worksheets(Target).Cells(Y + Cookie, X) = Worksheets(DataSource).Cells(Y, X) '固定工资 9 + 10 If (X = 4) Then Worksheets(Target).Cells(Y + Cookie, X) = Val(Worksheets(DataSource).Cells(Y, 9).Text) + Val(Worksheets(DataSource).Cells(Y, 10).Text) '绩效薪资标准，三个 If (X = 5 Or X = 6 Or X = 7) Then Worksheets(Target).Cells(Y + Cookie, X) = Worksheets(DataSource).Cells(Y, X + 6) '缺勤扣款 If (X = 8) Then Worksheets(Target).Cells(Y + Cookie, X) = Worksheets(DataSource).Cells(Y, 15) '其他工资 16 + 17 If (X = 9) Then Worksheets(Target).Cells(Y + Cookie, X) = Val(Worksheets(DataSource).Cells(Y, 16).Text) + Val(Worksheets(DataSource).Cells(Y, 17).Text) '福利收入 18 -> 22 If (X = 10) Then Worksheets(Target).Cells(Y + Cookie, X) = Val(Worksheets(DataSource).Cells(Y, 18).Text) + Val(Worksheets(DataSource).Cells(Y, 19).Text) + Val(Worksheets(DataSource).Cells(Y, 20).Text) + Val(Worksheets(DataSource).Cells(Y, 21).Text) + Val(Worksheets(DataSource).Cells(Y, 22).Text) '其它及奖惩 23 - 24 If (X = 11) Then Worksheets(Target).Cells(Y + Cookie, X) = Val(Worksheets(DataSource).Cells(Y, 23).Text) - Val(Worksheets(DataSource).Cells(Y, 24).Text) '应发工资 和 其他扣款 If (X = 12 Or X = 13) Then Worksheets(Target).Cells(Y + Cookie, X) = Worksheets(DataSource).Cells(Y, X + 13) '保险扣款 27 + 28 + 29 If (X = 14) Then Worksheets(Target).Cells(Y + Cookie, X) = Val(Worksheets(DataSource).Cells(Y, 27).Text) + Val(Worksheets(DataSource).Cells(Y, 28).Text) + Val(Worksheets(DataSource).Cells(Y, 29).Text) '实发工资 If (X = 15) Then Worksheets(Target).Cells(Y + Cookie, X) = Worksheets(DataSource).Cells(Y, MaxColCounts - 1) '调整样式 Worksheets(Target).Cells(Y + Cookie, X).Select Selection.Font.Bold = True Next Cookie = Cookie + 1 Next '数据生成完毕，开始样式调整 '总体调整 Cells.Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Worksheets(Target).Range("A1").SelectEnd Sub
今天(2012/07/29)又做了下修改，按照同学的一些改动需求：
1 Sub 工资条计算() 2 'Sheet名称 3 Dim DataSource As String 4 Dim Target As String 5 'Dim Tpl As String 6 Dim TableHeaderPos As Integer 7 Dim EmptyCol As Integer 8 Dim DataStartRow As Integer 9 Dim MaxColCounts As Integer 10 DataSource = "汇总明细" 11 Target = "宏工资条" 12 'Tpl = "工资表1" 13 TableHeaderPos = 4 14 DataStartRow = TableHeaderPos + 1 15 MaxColCounts = 32 '数据源中最大的横向宽度 16 MaxColTplCounts = 16 '生成工资表中的最大横向宽度 17 18 '收集工资单目标表头，写成死的表头 19 Dim TargetTableHeader(1 To 100) As String 20 '以下为注释 21 'Dim Temp As Integer 22 'Temp = 1 23 'Do 24 ' If (Worksheets(Tpl).Cells(1, Temp) = "" And Temp = MaxColTplCounts) Then Exit Do 25 ' TargetTableHeader(Temp) = Worksheets(Tpl).Cells(1, Temp) 26 ' Temp = Temp + 1 27 'Loop 28 TargetTableHeader(1) = "月份" 29 TargetTableHeader(2) = "姓名" 30 TargetTableHeader(3) = "中心/部门" 31 TargetTableHeader(4) = "固定工资" 32 TargetTableHeader(5) = "绩效薪资标准" 33 TargetTableHeader(6) = "本月季绩效系数" 34 TargetTableHeader(7) = "月季薪制绩效工资实发" 35 TargetTableHeader(8) = "缺勤扣款" 36 TargetTableHeader(9) = "其他工资" 37 TargetTableHeader(10) = "福利收入" 38 TargetTableHeader(11) = "其他及奖惩" 39 TargetTableHeader(12) = "应发工资" 40 TargetTableHeader(13) = "其他扣款" 41 TargetTableHeader(14) = "保险扣款" 42 TargetTableHeader(15) = "实发工资" 43 44 Temp = 1 45 '得到总共的数据条数 46 Dim AllDataCounts As Integer 47 Do 48 If (Worksheets(DataSource).Range("A" & Temp) = "") Then Exit Do 49 Temp = Temp + 1 50 Loop 51 AllDataCounts = Temp - TableHeaderPos - 1 52 53 '得到当前月份，工资单是上一个月 54 Dim NowMonth As String 55 Dim TableMonth As Integer 56 NowMonth = Format(Now, "m") 57 TableMonth = CInt(NowMonth) - 1 58 59 '开始填充数据 60 '外层循环，行数，Y 61 Dim TargetDataStartRow As Integer 62 Dim Cookie As Integer 63 Dim A As String 64 Dim B As String 65 Cookie = 1 66 TargetDataStartRow = 5 '默认从第5行开始 67 For Y = TargetDataStartRow To (TargetDataStartRow + AllDataCounts - 1) 68 '内层循环，列数，X 69 For X = 1 To (MaxColTplCounts - 1) 70 '写入表头 71 Worksheets(Target).Cells(Y + Cookie - 1, X) = TargetTableHeader(X) 72 '写入数据 73 '月份 74 If (X = 1) Then Worksheets(Target).Cells(Y + Cookie, X) = TableMonth 75 '姓名 76 If (X = 2 Or X = 3) Then Worksheets(Target).Cells(Y + Cookie, X) = Worksheets(DataSource).Cells(Y, X) 77 '固定工资 9 + 10 78 If (X = 4) Then Worksheets(Target).Cells(Y + Cookie, X) = Val(Worksheets(DataSource).Cells(Y, 9).Text) + Val(Worksheets(DataSource).Cells(Y, 10).Text) 79 '绩效薪资标准，三个 80 If (X = 5 Or X = 6 Or X = 7) Then Worksheets(Target).Cells(Y + Cookie, X) = Worksheets(DataSource).Cells(Y, X + 6) 81 '缺勤扣款 82 If (X = 8) Then Worksheets(Target).Cells(Y + Cookie, X) = Worksheets(DataSource).Cells(Y, 15) 83 '其他工资 16 + 17 84 If (X = 9) Then Worksheets(Target).Cells(Y + Cookie, X) = Val(Worksheets(DataSource).Cells(Y, 16).Text) + Val(Worksheets(DataSource).Cells(Y, 17).Text) 85 '福利收入 18 -> 22 86 If (X = 10) Then Worksheets(Target).Cells(Y + Cookie, X) = Val(Worksheets(DataSource).Cells(Y, 18).Text) + Val(Worksheets(DataSource).Cells(Y, 19).Text) + Val(Worksheets(DataSource).Cells(Y, 20).Text) + Val(Worksheets(DataSource).Cells(Y, 21).Text) + Val(Worksheets(DataSource).Cells(Y, 22).Text) 87 '其它及奖惩 23 - 24 88 If (X = 11) Then Worksheets(Target).Cells(Y + Cookie, X) = Val(Worksheets(DataSource).Cells(Y, 23).Text) + Val(Worksheets(DataSource).Cells(Y, 24).Text) 89 '应发工资 和 其他扣款 90 If (X = 12 Or X = 13) Then Worksheets(Target).Cells(Y + Cookie, X) = Worksheets(DataSource).Cells(Y, X + 13) 91 '保险扣款 27 + 28 + 29 92 If (X = 14) Then Worksheets(Target).Cells(Y + Cookie, X) = Val(Worksheets(DataSource).Cells(Y, 27).Text) + Val(Worksheets(DataSource).Cells(Y, 28).Text) + Val(Worksheets(DataSource).Cells(Y, 29).Text) 93 '实发工资 94 If (X = 15) Then Worksheets(Target).Cells(Y + Cookie, X) = Worksheets(DataSource).Cells(Y, MaxColCounts - 1) 95 Next 96 '把调整样式的代码放在这里，执行效率比较高 97 '表头，数据 98 A = RTrim(LTrim(Str(Y + Cookie - 1))) 99 B = RTrim(LTrim(Str(Y + Cookie)))100 '表头101 Worksheets(Target).Rows(A & ":" & A).Select102 Selection.Font.Size = 10103 Selection.RowHeight = 24104 '数据105 Worksheets(Target).Rows(B & ":" & B).Select106 Selection.Font.Size = 11107 Selection.RowHeight = 24108 Selection.Font.Bold = True109 Cookie = Cookie + 1110 Next111 '数据生成完毕，开始样式调整112 '总体调整113 Cells.Select114 With Selection115 .HorizontalAlignment = xlCenter116 .VerticalAlignment = xlCenter117 .WrapText = True118 .Orientation = 0119 .AddIndent = False120 .IndentLevel = 0121 .ShrinkToFit = False122 .ReadingOrder = xlContext123 .MergeCells = False124 End With125 Worksheets(Target).Range("A1").Select126 End Sub
回避现实的人，未来将更不理想。
