从匹配查找的行中查找每列的第一个非空白单元格以合并重复匹配项答案

【问题标题】：Find first non-blank cell for each column from rows that match lookup to merge duplicate matches从匹配查找的行中查找每列的第一个非空白单元格以合并重复匹配项
【发布时间】：2015-09-17 20:28:07
【问题描述】：

我有一个电子表格，它结合了来自多个来源的联系人列表，具有不同程度的完整性。一些联系人多次提供了他们的信息，但每次都将不同的字段留空。我希望通过组合行以填充空白值来删除至少一些重复项。

这是我的数据的简化示例

id    email                    phone    company    job title
01    johnsmith@example.com    5550123  acme inc   
01    johnsmith@example.com             acme inc   CEO
02    janedoe@gmail.com                 XYZ Co
02                             5555555
03    frank@school.edu
03    frank@school.edu                  school
03    frank@school.edu         5551111
04    bob@promoted.com                  job inc    VP Sales
04    bob@promoted.com                  job inc    mail clerk

如果我能够填补所有空白，那么删除重复项而不丢失数据并处理像最后一个这样的情况将是微不足道的。在不破坏或删除案例的同时进行重复数据删除的解决方案也可以。

我还没有找到一种方法让 vlookup 循环遍历所有匹配项，直到找到非空白结果，除非我对每一列进行了排序。不幸的是，我的真实数据有 100 多列和几千行，因此为每一列手动执行此操作是不切实际的。

【问题讨论】：

标签： excel excel-formula vlookup excel-2013 vba

【解决方案1】：

这里是怎么做的。

假设：

数据在 Sheet1 中，并且它们从单元格 A1 开始。
您有一张空白的 Sheet2。

程序：

切换到 Sheet2。
在单元格 A1 中输入以下公式：=Sheet1!A1
将该单元格复制到 B1 和 A2。
在单元格 B2 中输入以下公式：

。

=IFERROR(INDEX(INDEX(Sheet1!B:B,MATCH(Sheet1!$A2,Sheet1!$A:$A,0)):INDEX(Sheet1!B:B,MATCH(Sheet1!$A2,Sheet1!$A:$A,1)),MATCH(TRUE,LEN(INDEX(Sheet1!B:B,MATCH(Sheet1!$A2,Sheet1!$A:$A,0)):INDEX(Sheet1!B:B,MATCH(Sheet1!$A2,Sheet1!$A:$A,1)))>0,0)),"")

这是一个数组公式，必须用Ctrl+Shift+Enter确认。

复制单元格 B2。
选择 B3 到 B2000 的范围（或者你需要走多远）并粘贴。
通过单击工作表顶部的 B 列标题选择所有 B 列。
复制 B 列。
选择 C 到 Z 列（或任意多个）并粘贴。

就是这样。

提示：公式完成后，您可以复制 Sheet2 上的所有单元格，方法是单击工作表左上角的灰色小方块并将选择性粘贴为值。这将用工作表 2 上的硬值替换所有公式。

【讨论】：

为 B2 提供的公式从 IFERROR 返回空白结果。还没有花时间去追查哪里出了问题
它适用于您提供的示例数据。如果您愿意，我很高兴在您的实际文件上启动并运行它。我的电子邮件地址是：daniel.ferry@gmail.com

【解决方案2】：

这是基于这样的原则，即对一列空白和值进行排序会将空白留在底部。通过循环遍历列并对类似 ID 的每个部分进行排序，非空白值将上升到顶部。这些可以很容易地用于填充较低等级的单元格。

Sub fill_in_the_blanks()
    Dim rw As Long, cl As Long, id As Variant
    With Worksheets("Sheet1")
        With .Cells(1, 1).CurrentRegion
            .Cells.Sort Key1:=.Columns(1), Order1:=xlAscending, _
                        Orientation:=xlTopToBottom, Header:=xlYes
            For rw = 2 To .Rows.Count
                If id <> .Cells(rw, 1).Value2 Then
                    id = .Cells(rw, 1).Value2
                    With .Cells(rw, 1).Resize(Application.CountIf(.Columns(1), .Cells(rw, 1).Value), .Columns.Count)
                        For cl = 2 To .Columns.Count
                            .Cells.Sort Key1:=.Columns(1), Order1:=xlAscending, _
                                        Key2:=.Columns(cl), Order2:=xlAscending, _
                                        Orientation:=xlTopToBottom, Header:=xlNo
                            If CBool(Application.CountA(.Columns(cl))) And _
                             CBool(Application.CountBlank(.Columns(cl))) Then
                                With .Columns(cl).SpecialCells(xlCellTypeBlanks)
                                    .FormulaR1C1 = "=r[-1]c"
                                    .Value = .Value2
                                End With
                            End If
                        Next cl
                    End With
                End If
            Next rw
            .RemoveDuplicates Columns:=1, Header:=xlYes
        End With
    End With
End Sub

要处理的区域由Range.CurrentRegion property 管理。不应有完全空白的行或列来分隔数据的“孤岛”。

【讨论】：