conditionally concatenate text from multiple recor

2020-05-03 13:23发布

Sample Data: 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 ###" Str5 ###

I have a number of records (~4000) each with a UniqueID value (text) and a text field (potentially quite lengthy) which is a user-entered description of the data. I need to consolidate the spreadsheet by concatenating all the descriptions into a single record where there are multiple occurrences of the UniqueID value. Generically, I want to loop through the range of potential values and say "if UniqueID is equal, then take all of the Description values and concatenate them together in a single row (either the first row or a new row) then delete all the old rows." Basically, I want to create the ConsolidatedText field in this sample data, and then also delete the extra rows. This is beyond my VBA programming abilities, and any help with the structure of this macro would be greatly appreciated.

1条回答
姐就是有狂的资本
2楼-- · 2020-05-03 13:48
Option Explicit

Sub Tester()
    Dim d As Object
    Dim c As Range, sId, sDesc, k

    Set d = CreateObject("Scripting.Dictionary")
    For Each c In ActiveSheet.Range("A2:A4002")
        sId = Trim(c.Value)
        sDesc = c.Offset(0, 1).Value
        If Not d.Exists(sId) Then
            d(sId) = sDesc
        Else
            d(sId) = d(sId) & "   " & sDesc
        End If
    Next c

    DumpDict ActiveSheet.Parent.Sheets("Summary").Range("A2"), d

End Sub

Sub DumpDict(rng As Range, d As Object)
Dim k
    For Each k In d.Keys
        rng.Value = k
        rng.Offset(0, 1).Value = d(k)
        Set rng = rng.Offset(1, 0)
    Next k
End Sub
查看更多
登录 后发表回答