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

一个同学让我帮下他的忙，写一个能生成工资单的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
posted @ 2012-07-28 18:45  无墨来点睛  Views(2625)  Comments(0)  Edit  收藏  举报