工作需要，总是遇到一些棘手的数据合并，例如下一个表格：

wKiom1cQiqzy1KThAAAoDrp0xLs689.png

我们需要将姓名重复的人员合并，后面的多个职责依次排列，如果仅仅是复制粘贴，工作就太恐怖了，还好我对VBA比较了解，针对此问题，写了一个VLOOKUP的扩展函数，来辅助解决此问题。


1、EXCEL开发工具的调用，“文件”——“选项”——“自定义功能区”勾选开发工具（office2016，版本不同操作可能不同）或者直接快捷键Ctrl+Alt+F11调出，在Microsoft Excel对象上右键，插入选择“模块”就会在工程列表中出现模块1的选项

wKiom1cQjFaTZg2aAABJGlh4dxg501.png

双击“模块1”打开代码界面，输入以下代码，定义一个VLOOKUP_EX的自定义函数，然后保存

Function VLOOKUP_EX(lookValue As Range, dataReg As Range, arr_index As Integer)
'参数说明
'lookValue：查找值
'datareg：查找值所属的区域
'arr_index：返回的结果数组的index值

Dim DataArr
Dim ResultArr
Dim value_id%, col_id%, i%
DataArr = dataReg
ReDim ResultArr(1)
For value_id = 1 To UBound(DataArr, 1)
    If DataArr(value_id, 1) = lookValue Then
        '循环取改行的数值，到数组，直到为空时跳出
        For col_id = 3 To UBound(DataArr, 2)
            If DataArr(value_id, col_id) <> "" Then
                '添加到数组
                ResultArr(UBound(ResultArr)) = DataArr(value_id, col_id)
                ReDim Preserve ResultArr(UBound(ResultArr) + 1)
                ResultArr(UBound(ResultArr)) = ""
            Else
                '退出循环
                Exit For
            End If
        Next
    End If
Next
For i = LBound(ResultArr) To arr_index
    If i > UBound(ResultArr) Then
        VLOOKUP_EX = ""
        Exit For
    Else
        VLOOKUP_EX = ResultArr(i)
    End If
Next
End Function

2、函数的使用

首先，筛选出不重复的编号和姓名列表，然后单元格输入以下公式，如图：

wKiom1cQjffzxLFUAAAoIqIRytk187.png

C2的公式说明：从"原职责表!$A$2:$E$11"区域内，找出A2即编号，对应的结果，第三个参数指返回第几个结果，COLUMN(A2)结果为1，即返回第一个结果。


注意：第一个参数锁定列，因为横向拖动时保证查找值始终为编号列，第三个参数不锁定，表示横向拖动时，随着列编号依次变化，逐个取出结果内的所有值。


操作：将C2内公式横向拖动，得到一条结果；然后整行向下拖动，得到全部结果。


概括依据就是，在选定查找区域内，返回一个数组，通过第三个参数输出对应位置的数组元素！