首页 > 开发 > 其他 > 正文

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

2019-10-14 22:10:27
字体:
来源:转载
供稿:网友

一个同学让我帮下他的忙,写一个能生成工资单的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 





 

发表评论 共有条评论
用户名: 密码:
验证码: 匿名发表