作者：雷志辉（VBA技术分享主笔）

很多HR及财务人员对Excel重复工作加班加点出一份报表，或者输出一份表格抓破脑袋，如果你会一点VBA知识将大大提示工作效率

视频加载中...

如下情況：

需求：表格1中为人员信息sheet,表格2为人员薪酬信息，通过姓名进行管连输出按钮下面的结果

表格1

表格2

结果：

核心代码：

核心VO代码：

具体代码实现如下：

Option Explicit

'author leizhihui

Sub run_Click()

Dim dic, dicRecord As Variant

Dim row, i As Long

Dim ws, clearws As Worksheet

Dim rs As RecordVO

Dim salinfo As Worksheet

Set clearws = ThisWorkbook.Worksheets("人员基本信息") '获取人员基本信息表格(每次按钮测试进行结果数据清理)

row = clearws.Range("I2000").End(xlUp).row

clearws.Range("I6:L" & row).Clear '清理数据

Set dic = CreateObject("scripting.dictionary") '创建字典

Set ws = ThisWorkbook.Worksheets("人员基本信息") '获取人员基本信息表格

row = ws.Range("A2000").End(xlUp).row '获取人员基本信息实际信息行数

With ws

For i = 2 To row

If Not dic.exists(.Range("B" & i).Value) Then '判断姓名是否存在字典中

Set rs = New RecordVO

rs.set_Initialize .Range("B" & i).Value, .Range("C" & i).Value, .Range("D" & i).Value, 0 '实体数据填充

dic.Add Key:=.Range("B" & i).Value, Item:=rs

End If

Next i

End With

Set salinfo = ThisWorkbook.Worksheets("工资信息")

row = salinfo.Range("A2000").End(xlUp).row

With salinfo

For i = 2 To row

If dic.exists(.Range("A" & i).Value) Then

Set rs = dic.Item(.Range("A" & i).Value)

rs.salary = .Range("B" & i).Value

End If

Next i

End With

Dim j As Integer

j = 6

With ws

For Each dicRecord In dic.Items '输出结果数据字典

.Range("I" & j).Value = "月份"

boder .Range("I" & j)

.Range("J" & j).Value = "姓名"

boder .Range("J" & j)

.Range("K" & j).Value = "所属部门"

boder .Range("K" & j)

.Range("L" & j).Value = "薪水"

boder .Range("L" & j)

.Range("I" & j + 1).Value = dicRecord.month '月份

center .Range("I" & j + 1)

boder .Range("I" & j + 1)

.Range("J" & j + 1).Value = dicRecord.name '名字

boder .Range("J" & j + 1)

.Range("K" & j + 1).Value = dicRecord.dept '部门名称

boder .Range("K" & j + 1)

.Range("L" & j + 1).Value = dicRecord.salary '薪资

center .Range("L" & j + 1)

boder .Range("L" & j + 1)

j = j + 3

Next

End With

Set dic = Nothing

MsgBox "success！！！！"

End Sub

Function center(ByRef ranges)

With ranges

.HorizontalAlignment = xlLeft

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

End Function

Sub boder(ByRef ranges)

'

' boder 宏

' boder

'

'

ranges.Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)

.Color = -16776961

.LineStyle = xlContinuous

.ColorIndex = 1

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.ColorIndex = 1

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.ColorIndex = 1

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.ColorIndex = 1

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlInsideVertical)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlInsideHorizontal)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

End Sub