一个同学让我帮下他的忙，写一个能生成工资单的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").Select
End 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).Select 102 Selection.Font.Size = 10 103 Selection.RowHeight = 24 104 '数据 105 Worksheets(Target).Rows(B & ":" & B).Select 106 Selection.Font.Size = 11 107 Selection.RowHeight = 24 108 Selection.Font.Bold = True 109 Cookie = Cookie + 1 110 Next 111 '数据生成完毕，开始样式调整 112 '总体调整 113 Cells.Select 114 With Selection 115 .HorizontalAlignment = xlCenter 116 .VerticalAlignment = xlCenter 117 .WrapText = True 118 .Orientation = 0 119 .AddIndent = False 120 .IndentLevel = 0 121 .ShrinkToFit = False 122 .ReadingOrder = xlContext 123 .MergeCells = False 124 End With 125 Worksheets(Target).Range("A1").Select 126 End Sub
