基于公共单元格连接 (Excel) 行，包括不同的列

Question

我一直在寻找一种方法来连接基于公共单元格的 Excel（或任何其他工具/软件处理表）行。举个例子：

我有这个制表位分隔表。每个值都位于单独的行中：

angeb*    12      16      18    
zyste*        60      61        
zynisch*      12            
zyste*        60            
abstreit*     70            
anflunker*    70            
angeb*    70    

我想以某种方式连接行，结果将是：

angeb*    12      16      18      70
zyste*        60      61        
zynisch*      12                    
abstreit*     70            
anflunker*    70

它确实按照this tutorial 中的建议工作，但它仅将单个单元格值连接到另一个单元格中。我也尝试过基本上由this so question 提出的路径，最后将我引向VLOOKUP (description)。但它们都连接在单元格中。

基本上很简单，我需要将具有相同第 1 列的单元格合并，但保留列，只是连接超出。一旦第二行添加到第一行，就可以删除第二行。我尝试调整上述脚本，但我无法一步到位，只需将逗号分隔的值转换为单元格并将它们复制到新列即可。我不是 VBA 专家，但这似乎是一个非常简单的功能，我可能会遗漏一些东西。任何帮助是极大的赞赏。

Answer 1

我已经写了我所做的每一部分并用颜色编码，但这里是一般的方法：

1. 对所有数据进行 A-Z 排序
2. 使用 CountIf 语句计算特定数据行出现的次数。
3. 假设 3 列数据，求 MaxRows 的 MAX()，相乘（这里，3 列 x 2 行最大值观察 = 6 数据最大值）。
4. 复制标签，删除重复项 [绿色]，这样您就有了一个精简的表格。
5. 使用 IndexMatch 方程，结合 IF 和 IFERROR 语句对数据进行重新排序。请注意 P-Q 列的 +1）

问题 - 你仍然可以得到一个差距，但现在都在同一行！

这是一个关于我是如何做到的快速 Youtube 视频。 TSpinde Answer 1

Answer 2

我对你的问题有点困惑，所以我只连接了完全相同的名称。

所以我的代码的工作方式是创建一个标签数组，当它遇到一个已经拥有的标签时，它会在原始行中查找下一个空槽。然后它添加值并执行此操作，直到它遇到新行中的空单元格。降低 lastrow 值并更改它所在的行有一些有趣的事情，但它有必要在下一个周期移动到正确的数据行。

该宏假定所有可能的数据条目是并排的，例如，如果 D2 为空，则 C2 和 E2 中不会有值。

Sub macro()

Dim LastRow As Long
Dim LastCol As Long
Dim TagArray() As String
Dim count As Long
Dim i As Long
Dim j As Long
Dim PreExisting As Boolean
Dim Targetrow As Long

ReDim TagArray(1 To 1)
LastRow = Worksheets(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = Worksheets(1).Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
TagArray(1) = Worksheets(1).Range("A1").Value

For i = 2 To LastRow
    PreExisting = False

    For j = 1 To UBound(TagArray)
        If Worksheets(1).Cells(i, 1) = TagArray(j) Then
            PreExisting = True
            Targetrow = j
            Exit For
        End If
    Next j

    If PreExisting Then
        For j = 2 To LastCol
            If Not IsEmpty(Worksheets(1).Cells(i, j)) Then
                For count = 1 To LastCol
                    If IsEmpty(Worksheets(1).Cells(Targetrow, count)) Then
                        Worksheets(1).Cells(Targetrow, count) = Worksheets(1).Cells(i, j)
                        Exit For
                    Else
                        If count = LastCol Then
                            LastCol = LastCol + 1
                            Worksheets(1).Cells(Targetrow, LastCol) = Worksheets(1).Cells(i, j).Value
                        End If
                    End If
                Next count
            Else
                Exit For
            End If
        Next j
        Worksheets(1).Rows(i).Delete
        LastRow = LastRow - 1
        i = i - 1
    Else
        ReDim Preserve TagArray(1 To UBound(TagArray) + 1)
        TagArray(UBound(TagArray)) = Worksheets(1).Cells(i, 1)
    End If

Next i

End Sub

希望如果您想在 VBA 中使用它而不是工作表函数，您会发现这很有用。