怎样用excel VBA计算并合并同一姓名的工资

怎样用excel VBA计算并合并同一姓名的工资

经常有这种情况：

1.工资表按部门分为多个表，不同的部门会有同名的人。

2.同一部门中的某一个人可能担任不同的职位，他的工资就分在几行里。

3.现在需要将所有部门人员的工资汇总到一个表中，若某一个人的工资占几行，则合并 姓名列和工资。如下图：

将表格另存为启用宏的工作表(*.xlsm)

新建工作表,命名为汇总,在表头右键-查看代码-进入VBA编辑器

将以下代码复制到编辑器中：

Sub 合并汇总()

Application.DisplayAlerts = False '禁止合并单元格时出现警告

'以下为合并表格

Dim sht As Worksheet, xrow As Integer

For Each sht In Worksheets

If sht.Name <> ActiveSheet.Name Then

sht.UsedRange.Copy '复制整表

ActiveSheet.Range("a65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormulas '从第一个空行选择性粘贴

End If

Next

'以下删除第一行和多余的标题行

Rows(1).Delete

Dim x As Integer

For x = 2 To UsedRange.Rows.Count

If Cells(x, 1) = "姓名" Then

Rows(x).Delete

End If

Next x

'以下为排序

heng = UsedRange.Rows.Count

lie = UsedRange.Columns.Count

Range(Cells(2, 1), Cells(heng, lie)).Sort Key1:=Range("B1"), Key2:=Range("A1")

'以下为合并同名单元格

Dim i As Integer

Dim first As Integer

Dim last As Integer

first = 2

last = 2

For i = 2 To UsedRange.Rows.Count

If Cells(i, 1) = Cells((i + 1), 1) Then

Else

last = i

Cells(first, 6) = Application.Sum(Range(Cells(first, 6), Cells(last, 6))) '计算同名的总工资

Range(Cells(first, 1), Cells(last, 1)).Select

Selection.Merge '合并姓名

Range(Cells(first, 6), Cells(last, 6)).Select

Selection.Merge '合并工资

first = i + 1

End If

Next i

End Sub

点击运行按钮

运行结果如下