有条件地连接来自vba中多个记录的文本[重复]

Question

UniqueID Description            ConsolidatedText   
Str1     Here is a sentence     Here is a sentence 
Str2     And another sentence.  And another sentence. And some words                       
Str2     And some words         
Str3     123                    123
Str4     abc                    abc ###
Str4     ###                    

好的 - 我会再试一次。上一篇标题相同且代码无格式的帖子请忽略！！

我有许多记录（约 4000 条），每条记录都有一个 UniqueID 值（文本）和一个文本字段（可能很长），这是用户输入的数据描述。我需要通过将所有描述连接到一个记录中来合并电子表格，其中多次出现 UniqueID 值。通常，我想遍历潜在值的范围并说“如果 UniqueID 相等，则获取所有描述值并将它们连接到一行中（第一行或新行），然后删除所有旧的行。”基本上，我想在此示例数据中创建 ConsolidatedText 字段，然后还删除多余的行。这超出了我的 VBA 编程能力，任何有关此宏结构的帮助将不胜感激。

Answer 1

如果你不想做 vba（如果这只是一次），你可以这样做：

1. 添加“ConsolidatedText”列
2. 按 UniqueID 对值进行排序
3. 在“ConsolidatedText”中创建一个公式（C2 中的第一个并将公式拖放到最后）： =IF(A2=A3;B2&" "&B3;IF(A2=A1;"dupplicate";B2))
4. 过滤 ConsolidatedText 的“重复”值并删除所有这些行

如果您有超过 2 个相同的 id，我让您调整公式。

Answer 2

试试下面的代码，它假设你有标题，唯一的 ID 在 A 列，描述在 B 列。

Option Explicit
Sub HTH()
    Dim vData As Variant
    Dim lLoop As Long
    Dim strID As String, strDesc As String

    '// Original data sheet, change codename to suit
    vData = Sheet1.UsedRange.Value

    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1

        For lLoop = 1 To UBound(vData, 1)
            strID = vData(lLoop, 1):strDesc = vData(lLoop, 2)

            If Not .exists(strID) Then
                .Add strID, strDesc
            Else
               .Item(strID) = .Item(strID) & " " & strDesc
            End If
        Next

       '// Data output, change sheet codename to suit
        Sheet2.Range("a1").Resize(.Count).Value = Application.Transpose(.keys)
        Sheet2.Range("b1").Resize(.Count).Value = Application.Transpose(.items)
    End With

End Sub

编辑

如果您想擦除并覆盖原始数据，请尝试：

Option Explicit
Sub HTH()
    Dim vData As Variant
    Dim lLoop As Long
    Dim strID As String, strDesc As String

    '// Change all references of activesheet to your worksheet codename.

    With ActiveSheet.UsedRange
        vData = .Value
        .Clear
    End With

    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1

        For lLoop = 1 To UBound(vData, 1)
            strID = vData(lLoop, 1):strDesc = vData(lLoop, 2)

            If Not .exists(strID) Then
                .Add strID, strDesc
            Else
               .Item(strID) = .Item(strID) & " " & strDesc
            End If
        Next

       '// Data output, change sheet codename to suit
        ActiveSheet.Range("a1").Resize(.Count).Value = Application.Transpose(.keys)
        ActiveSheet.Range("b1").Resize(.Count).Value = Application.Transpose(.items)
    End With

End Sub