一個同學讓我幫下他的忙，寫一個能生成工資單的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