如何根据 1 个函数的条件组合 2 个 VBA 函数？

Question

我有一个数据集，其中联系信息和姓名与个人工作过的公司相关联。 1个人可以与许多公司相关联。我想整合个人信息，但保留不同公司名称的信息。

我有一个 VBA 函数可以删除重复的行（姓名和联系信息），另一个 VBA 函数可以将两个单独的单元格（公司名称）合并为一个合并单元格。数据不按任何特定字段排序。

我想创建一个函数来删除重复的行，然后合并公司名称单元格，但仅适用于删除重复行的个人（意味着个人与超过 1 家公司相关联）。

感谢您的帮助！

原始数据格式示例：

这是VBA函数1的函数和结果：

Sub RemoveDuplicates()
'UpdatebyExtendoffice20160918
 
    Dim xRow As Long
    Dim xCol As Long
    Dim xrg As Range
    Dim xl As Long
    On Error Resume Next
    Set xrg = Application.InputBox("Select a range:", "Kutools for Excel", _
                                    ActiveWindow.RangeSelection.AddressLocal, , , , , 8)
 
    xRow = xrg.Rows.Count + xrg.Row - 1
    xCol = xrg.Column
    'MsgBox xRow & ":" & xCol
    Application.ScreenUpdating = False
    For xl = xRow To 2 Step -1
        If Cells(xl, xCol) = Cells(xl - 1, xCol) Then
            Cells(xl, xCol) = ""
        End If
    Next xl
    Application.ScreenUpdating = True
    
End Sub

函数 2 在下面，该模块只是连接和合并单元格，但我不知道如何编写一个仅适用于个人已删除重复行的函数（意味着该个人与多家公司相关联）。

Sub MergeCells()
    Dim xJoinRange As Range
    Dim xDestination As Range
        
    Set xJoinRange = Application.InputBox(prompt:="Highlight source cells to merge", Type:=8)
    Set xDestination = Application.InputBox(prompt:="Highlight destination cell", Type:=8)
    temp = ""
    For Each Rng In xJoinRange
        temp = temp & Rng.Value & " "
    Next
    xDestination.Value = temp
End Sub

    
    

Answer 1

我会以不同的方式处理此问题并使用 Excel 2010+ 中提供的 Power Query。

Power Query 作为“分组依据”方法，您可以在其中选择要分组的列 - 在您的情况下，它将是除 Company 列之外的所有列。然后，您可以使用换行符连接公司列，并获得您想要的结果。

• Data --> Get & Transform Data --> From Table/Range

• 选择除公司和Group By以外的所有列

• 操作是All Rows

• 添加自定义列（用公式拆分公司名称：
  • Table.Column([Grouped],"Company")

• 选择自定义列顶部的双头箭头
  • 从列表中提取值
  • 使用换行符作为分隔符#(lf)
• 关闭并加载到

您可能需要对电话号码进行一些自定义格式设置，并为公司列设置自动换行。

这是生成的MCode：

let
    Source = Excel.CurrentWorkbook(){[Name="Table3"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Email", type text}, {"Phone", Int64.Type}, {"First Name", type text}, {"Last Name", type text}, {"Company", type text}}),
    #"Grouped Rows" = Table.Group(#"Changed Type", {"Email", "Phone", "First Name", "Last Name"}, {{"Grouped", each _, type table [Email=text, Phone=number, First Name=text, Last Name=text, Company=text]}}),
    #"Added Custom" = Table.AddColumn(#"Grouped Rows", "Company", each Table.Column([Grouped],"Company")),
    #"Extracted Values" = Table.TransformColumns(#"Added Custom", {"Company", each Text.Combine(List.Transform(_, Text.From), "#(lf)"), type text})
in
    #"Extracted Values"

结果如下：