用vba有条件地连接多个记录中的文本

发布于 2024-11-29 20:23:37 字数 436 浏览 0 评论 0原文

样本数据: UniqueID 描述 ConsolidatedText Str1 这是一个句子 这是一个句子 Str2 又一句话。还有一句话。还有一些话 Str2 还有一些话 STR3 123 123
Str4 abc abc ###" Str5 ###

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

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.

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(1

睡美人的小仙女 2024-12-06 20:23:37
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
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
~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文