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  ###      

OK - もう一度やり直してください。同じタイトルとフォーマットされていないコードで前の投稿を無視してください！

私はUniqueID値（テキスト）とデータ入力の説明であるテキストフィールド（潜在的にかなり長い）を持つ多数のレコード（〜4000）を持っています。 UniqueID値が複数存在する場合は、すべての説明を1つのレコードに連結してスプレッドシートを統合する必要があります。一般的に、私は潜在的な値の範囲をループして、 "UniqueIDが等しいならば、すべての説明の値を取り、単一の行（最初の行または新しい行のいずれか）で連結し、古い行。基本的には、このサンプルデータにConsolidatedTextフィールドを作成し、余分な行を削除したいと考えています。これは私のVBAプログラミング能力を超えており、このマクロの構造に関する助けがあれば幸いです。

Answer 1

以下のコードを試してみてください、それはあなたがヘッダを持っていると仮定して、そのユニークなIDが列Bの列Aと説明している

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 

EDIT

あなたが消去して上書きする場合元のデータを次に試してみてください：

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. は一意IDによって自分の価値観を並べ替えるには、列「ConsolidatedText」
2. を追加します。
3. （C2及び抗力の最初のものとドロップ終了まで式）「をConsolidatedText」の式を作成する： =IF(A2=A3;B2&" "&B3;IF(A2=A1;"dupplicate";B2))
4. フィルタConsolidatedTextの「dupplicate」の値を、すべてのこれらの行を削除

同じIDが2つ以上ある場合は、式を調整できます。