有条件地连接来自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

尝试下面的代码，它假设你有标题和唯一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 

Answer 2

如果你不想做的VBA（如果这只是一个镜头），这里是你可以做什么：

1. 添加列“ConsolidatedText”
2. 排序你的价值观通过的UniqueID
3. 创建“ConsolidatedText”式（第一个在C2和拖放式直到结束）： =IF(A2=A3;B2&" "&B3;IF(A2=A1;"dupplicate";B2))
4. 滤波器ConsolidatedText的“dupplicate”值，并删除所有这些行

我让你修改公式，如果你有超过2个相同的ID。