尝试了一下写Excel宏的VBA脚本

一个同学让我帮下他的忙，写一个能生成工资单的Excel宏，从工资明细表中抽取相关数据，生成简易明了的工资单，尝试了一下，代码如下，仅作为记录：
 

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.     Dim Temp As Integer 
21.     Temp = 1 
22.     Do 
23.         If (Worksheets(Tpl).Cells(1, Temp) = "" And Temp = MaxColTplCounts) Then Exit Do 
24.         TargetTableHeader(Temp) = Worksheets(Tpl).Cells(1, Temp) 
25.         Temp = Temp + 1 
26.     Loop 
27.       
28.     Temp = 1 
29.     '得到总共的数据条数 
30.     Dim AllDataCounts As Integer 
31.     Do 
32.          If (Worksheets(DataSource).Range("A" & Temp) = "") Then Exit Do 
33.          Temp = Temp + 1 
34.     Loop 
35.     AllDataCounts = Temp - TableHeaderPos - 1 
36.       
37.     '得到当前月份，工资单是上一个月 
38.     Dim NowMonth As String 
39.     Dim TableMonth As Integer 
40.     NowMonth = Format(Now, "m") 
41.     TableMonth = CInt(NowMonth) - 1 
42.       
43.     '开始填充数据 
44.     '外层循环，行数，Y 
45.     Dim TargetDataStartRow As Integer 
46.     Dim Cookie As Integer 
47.     Cookie = 1 
48.     TargetDataStartRow = 5 '默认从第5行开始 
49.     For Y = TargetDataStartRow To (TargetDataStartRow + AllDataCounts - 1) 
50.         '内层循环，列数，X 
51.         For X = 1 To (MaxColTplCounts - 1) 
52.             '写入表头 
53.             Worksheets(Target).Cells(Y + Cookie - 1, X) = TargetTableHeader(X) 
54.             '调整表头样式 
55.             Worksheets(Target).Cells(Y + Cookie - 1, X).Select 
56.             Selection.Font.Size = 10 
57.             '写入数据 
58.             '月份 
59.             If (X = 1) Then Worksheets(Target).Cells(Y + Cookie, X) = TableMonth 
60.             '姓名 
61.             If (X = 2 Or X = 3) Then Worksheets(Target).Cells(Y + Cookie, X) = Worksheets(DataSource).Cells(Y, X) 
62.             '固定工资 9 + 10 
63.             If (X = 4) Then Worksheets(Target).Cells(Y + Cookie, X) = Val(Worksheets(DataSource).Cells(Y, 9).Text) + Val(Worksheets(DataSource).Cells(Y, 10).Text) 
64.             '绩效薪资标准，三个 
65.             If (X = 5 Or X = 6 Or X = 7) Then Worksheets(Target).Cells(Y + Cookie, X) = Worksheets(DataSource).Cells(Y, X + 6) 
66.             '缺勤扣款 
67.             If (X = 8) Then Worksheets(Target).Cells(Y + Cookie, X) = Worksheets(DataSource).Cells(Y, 15) 
68.             '其他工资 16 + 17 
69.             If (X = 9) Then Worksheets(Target).Cells(Y + Cookie, X) = Val(Worksheets(DataSource).Cells(Y, 16).Text) + Val(Worksheets(DataSource).Cells(Y, 17).Text) 
70.             '福利收入 18 -> 22 
71.             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) 
72.             '其它及奖惩 23 - 24 
73.             If (X = 11) Then Worksheets(Target).Cells(Y + Cookie, X) = Val(Worksheets(DataSource).Cells(Y, 23).Text) - Val(Worksheets(DataSource).Cells(Y, 24).Text) 
74.             '应发工资 和 其他扣款 
75.             If (X = 12 Or X = 13) Then Worksheets(Target).Cells(Y + Cookie, X) = Worksheets(DataSource).Cells(Y, X + 13) 
76.             '保险扣款 27 + 28 + 29 
77.             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) 
78.             '实发工资 
79.             If (X = 15) Then Worksheets(Target).Cells(Y + Cookie, X) = Worksheets(DataSource).Cells(Y, MaxColCounts - 1) 
80.             '调整样式 
81.             Worksheets(Target).Cells(Y + Cookie, X).Select 
82.             Selection.Font.Bold = True 
83.         Next 
84.         Cookie = Cookie + 1 
85.     Next 
86.     '数据生成完毕，开始样式调整 
87.     '总体调整 
88.     Cells.Select 
89.     With Selection 
90.         .HorizontalAlignment = xlCenter 
91.         .VerticalAlignment = xlCenter 
92.         .WrapText = True 
93.         .Orientation = 0 
94.         .AddIndent = False 
95.         .IndentLevel = 0 
96.         .ShrinkToFit = False 
97.         .ReadingOrder = xlContext 
98.         .MergeCells = False 
99.     End With 
100.     Worksheets(Target).Range("A1").Select 
101. 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