有条件地连接vba中多个记录的文本 [英] conditionally concatenate text from multiple records in vba

问题描述

样本数据：
UniqueID描述ConsolidatedText
Str1这里是一个句子这里是一个句子
Str2和另一个句子。又一句话。和一些单词
Str2和一些单词
Str3 123 123

Str4 abc abc ###
Str5 ###

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

我有一些记录（〜4000），每个记录具有UniqueID值（文本）和一个文本字段（可能相当长），这是一个用户输入的数据描述，我需要整合电子表格将所有描述连接到单个记录中，其中存在多次出现的UniqueID值。通常，我想循环遍历潜在值的范围，并说如果UniqueID相等，然后取所有描述值并将它们连接在一起单行（第一行或新行）然后删除所有旧行。基本上，我想在此示例数据中创建ConsolidatedText字段，然后还删除额外的行，这超出了我的VBA编程能力，并且对此宏的结构的任何帮助将不胜感激。

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.

推荐答案

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

这篇关于有条件地连接vba中多个记录的文本的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！