基于单元格值合并邮箱地址：将同一企业邮箱归集到一行

方法一：使用TEXTJOIN函数（Excel 2019/365 适用） #

在输出结果列的第一行（比如E2单元格）输入以下公式，旧版Excel需按Ctrl+Shift+Enter作为数组公式执行，365版本直接回车即可：

=TEXTJOIN("; ", TRUE, IF($A$2:$A$19=A2, $D$2:$D$19, ""))

• 公式说明：
  • "; "：指定邮箱之间的分隔符
  • TRUE：自动忽略空白单元格
  • $A$2:$A$19=A2：匹配当前行的企业名称
  • $D$2:$D$19：提取对应企业的所有邮箱地址

若要清理重复的企业行，可选中数据区域，点击「数据」→「删除重复值」，仅勾选「企业名称」列，保留每个企业的第一行后再批量填充公式。

方法二：VBA宏解决方案 #

如果需要批量自动处理，可使用以下VBA代码：

Sub MergeEmailsByCompany()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim currentCompany As String
    Dim emailList As String
    
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To lastRow
        currentCompany = ws.Cells(i, "A").Value
        emailList = ws.Cells(i, "D").Value
        
        ' 遍历后续行，合并同企业邮箱
        For j = i + 1 To lastRow
            If ws.Cells(j, "A").Value = currentCompany Then
                emailList = emailList & "; " & ws.Cells(j, "D").Value
                ws.Cells(j, "E").ClearContents ' 清空重复行的输出列
            Else
                Exit For ' 企业不同，终止内层循环
            End If
        Next j
        
        ws.Cells(i, "E").Value = emailList
        i = j - 1 ' 跳过已处理的重复行
    Next i
End Sub

使用步骤： #

1. 打开目标Excel文件，按Alt+F11打开VBA编辑器
2. 右键点击当前工作簿，选择「插入」→「模块」
3. 将上述代码粘贴到模块窗口中
4. 按F5运行宏，或回到Excel界面通过「开发工具」→「宏」执行

内容的提问来源于stack exchange，提问作者Brent