工资条制作问题

1.提出问题
前几天群里提出了工资条制作的问题，就是每一行上都插入“姓名”、“收入”等表头，见图1-1 工资条制作示例。

笔者考虑到会有一部分人在工作中再次遇到此类问题，故将大家意见总结整合，发布出来。

图1-1 工资条制作示例
2.集思广议
问题提出后，大家集思广议，很快提出各种办法给予解决，在这里笔者总结并推广一下：
（1）“北京-无聊~”提出使用内置函数，用IF、MOD、ROW和OFFSET的组合来解决这一问题；（2）笔者（晚安地球人）提出用VBA来实现。

当然，在这之前“杭州-sharpen”已经提出过并编写过函数。

上述两种方法都可顺利解决问题，并各有各的优缺点。

前者适合普通用户使用，易于修改和移植，例如在各工资条之间多插入一行空行，稍微变动一下函数就可以，但使用效率不如相比VBA方法来的高；后者使用编程的方法，程序写好之后，使用效率肯定很高，但对于不懂程序的人来说，当特殊需要要求变动格式时，改动代码则变得很困难，甚至无法使用。

3 解决问题
3.1 内置函数
示例工资见表2-1。

其中“姓名”位于A1单元格。

表2-1 示例工资
姓名收入饭补车贴总和
A 2000 10 100 2110
B 2500 11 101 2612
C 1500 12 102 1614
D 2000 13 103 2116
E 2500 14 104 2618
按“北京-无聊~”提出的方法，在某空白处输入公式：
=IF(MOD(ROW(A1),2)=1,A$1,OFFSET($A$1,(ROW(A1)+1)/2,0)) 式1 则会得到“姓名”，往下拖，依次得到“A”、“姓名”、“B”、“姓名”、“C”……，直到得到全部行为止。

其中：
ROW([reference])：引用所在行的行号。

ROW(A1)=1，表示第1行。

MOD(number, divisor)：返回两数相除的余数。

MOD(1,2)=1，表示1除以2得0余1。

OFFSET(reference, rows, cols)(此处简化)：以指定的引用为参照系，通过给定偏移量得到新的引用。

OFFSET($A$1,1, 0)表示从$A$1偏移1行0列到$A$2。

IF(logical_test, [value_if_true], [value_if_false])，即IF(判别式，正确时值，错误时值)。

那么在姓名右侧，输入公式：
=IF(MOD(ROW(B1),2)=1,B$1,OFFSET($B$1,(ROW(B1)+1)/2,0)) 式2
得到“收入”，往下拖，会得到“2000”、“收入”、“2500”等。

注意式1和式2差别之处在于$A$1和$B$1，同样“饭补”、“车贴”、“总和”就在此基础上变化$C$1、$D$1、$E$1。

这样依次拖下去，便得到完整的工资条，见表3-2。

表3-2 工资条
姓名收入饭补车贴总和
A 2000 10 100 2110
姓名收入饭补车贴总和
B 2500 11 101 2612
姓名收入饭补车贴总和
C 1500 12 102 1614
姓名收入饭补车贴总和
D 2000 13 103 2116
姓名收入饭补车贴总和
E 2500 14 104 2618
上面搞懂了之后，公式换成：
=IF(MOD(ROW(A1),3)=0,"",IF(MOD(ROW(A1),3)=1,A$1,OFFSET($A$1,(ROW(A1)+1)/3,)))
效果便是在工资条间插入一空行，见图3-1。

图3-1 工资条间隔一行
3.2 VBA
本来VBA只在群中讨论涉及的，但作为一种方法，在这里提出。

鉴于大多人很少涉及VBA，在这只给出代码和使用方法。

笔者编写的窗体见图3-2。

图3-2 工资条制作窗体程序图
选好区域后，点击“生成工资条”，即可完成工资条制作任务。

因无法上传窗体文件，这里笔者将窗体抛弃，编写一个函数，通过信息输入框InputBox来与用户交互。

使用方法：打开Excel，按Alt+F11进入VBE，在VBAProject中，右击插入模块，粘贴以下代码，按F5即运行。

或在关闭VBE返回Excel界面时，按Alt+F8，运行GZT。

…代码开始********************************************************************‟
Option Base 1
' time 2012年4月10日
' by 晚安地球人
' url /236367275
Sub GZT()
On Error GoTo err
Dim arrHead As Variant
Dim arrData As Variant
Dim headArea As String
Dim dataArea As String
Dim IsExist As Boolean
IsExist = False
headArea = InputBox("请输入表头区域", "输入", "Sheet1!A1:E1") dataArea = InputBox("请输入数据区域", "输入", "Sheet1!A2:E12") If Trim(headArea) <> "" And Trim(dataArea) <> "" Then arrHead = Range(headArea).Value
arrData = Range(dataArea).Value
Dim rowNum As Integer
Dim colNum As Integer
rowNum = Range(dataArea).Rows.Count
colNum = Range(dataArea).Columns.Count
Dim arr()
ReDim arr(rowNum * 2, colNum)
For i = 1 To rowNum
For j = 1 To colNum
arr(2 * i - 1, j) = arrHead(1, j)
arr(2 * i, j) = arrData(i, j)
Next j
Next i
For i = 1 To Worksheets.Count
If Sheets(i).Name = "工资条(晚安地球人)" Then
Sheets(i).Range("A1:IV65536").Clear
IsExist = True
Exit For
End If
Next i
If IsExist = False Then
Dim xlSheet As Worksheet
Set xlSheet = Worksheets.Add(After:=ActiveSheet)
= "工资条(晚安地球人)"
End If
Sheets("工资条(晚安地球人)").Range(Cells(1, 1), Cells(rowNum * 2, colNum)).Value = arr() GoTo ok
Else
MsgBox "请选择表头或数据区域"
GoTo ok
End If
err:
MsgBox "error"
ok:
End Sub
…代码结束。