工资条打印_ 利用VBA数组将工资表分解成工资条_excel工资条打印设置

大家好，今日我们继续讲解VBA数组与字典解决方案，今日讲解第75讲内容：利用数组将工资表分解成工资条。

字典和数组在实际的应用中有很多，假如你是财务人员可以考虑今日我讲的内容和下一讲的内容，就是如何把工资表变成工资条，下面我们来根据实例讲解。

实例，如下面

的截图，是一个工作表，这些工资表的内容变成工资条，就是每个条条上都有抬头，为了分发方便要把每个工资条间留出空格，该怎么做到呢？今日我讲解单纯用数组的方案，在下一讲我将讲解用字典的方法。

思路分析：先将数据放到数组中，然后提取出每行数据进行处理，回填数据后，然后是格式的复制。

下面看我给出的代码：

Sub mynzsz_75() '第75讲 利用数组将工资表分解成工资条

Dim mybrr()

Sheets("75").Select

'将源数据存入数组

myarr = Range("a1:f" & Range("a1").End(xlDown).Row)

'结果放入动态数组中mybrr

ReDim Preserve mybrr(1 To 6, 1 To UBound(myarr, 1) * 3 - 3)

For i = 2 To UBound(myarr)

'将记录第i条记录存入mycrr

mycrr = Application.Index(myarr, i, 0)

'设置行数

t = (i - 1) * 3 - 2

'mybrr()是列行的赋值

For j = 1 To UBound(mycrr)

mybrr(j, t) = Application.Index(myarr, 1, 0)(j)

mybrr(j, t + 1) = mycrr(j)

Next

Next i

Sheets("工资条打印").Select

Cells.Clear

'在工资条中填入数据

With Range("a1").Resize(UBound(mybrr, 2), 6)

'结果要转置后回填

.Value = Application.Transpose(mybrr)

'在工资条中填入格式

Sheets("75").Range("a1:f3").Copy '此处是A1:F3

.SpecialCells(xlCellTypeConstants, 23).Select

.PasteSpecial xlPasteFormats

Application.CutCopyMode = False

End With

End Sub

代码的截图：

代码分析：

1 上述代码将工作表变成工资条。本讲的内容主要利用了数组，利用了数组的提取，数组的转置，格式的复制等等

2 'mybrr()是列行的赋值

For j = 1 To UBound(mycrr)

mybrr(j, t) = Application.Index(myarr, 1, 0)(j)

mybrr(j, t + 1) = mycrr(j)

Next

上述语句中实现了将工资表的数据按行存入mybrr中，同时mybrr(j, t) = Application.Index(myarr, 1, 0)(j)，设置了行数据的抬头。注意要理解此处(j, t)的含义，j是列的t是行。

3 '在工资条中填入数据

With Range("a1").Resize(UBound(mybrr, 2), 6)

'结果要转置后回填

.Value = Application.Transpose(mybrr)

上述语句回填时用了转置，将行和列进行了归于正常的位置。

4 '在工资条中填入格式

Sheets("75").Range("a1:f3").Copy '此处是A1:F3

.SpecialCells(xlCellTypeConstants, 23).Select

.PasteSpecial xlPasteFormats

Application.CutCopyMode = False

上述预计实现了格式的复制，注意理解复制的时候要多复制一行。

下面看代码的运行：