如何将每个唯一 ID 的不同文本字符串组合成 1 行
下图显示了一个示例数据表(A 列到 B 列),右侧的表(E 列到 F 列)显示了我想要的输出。
可以有任意多个相同的 ID。同一ID中的数据可以多次复制,也可以包含不同的数据。
我需要组合每个 ID 的所有不同数据项。
如果有多个数据项,则数据项将以逗号分隔,并且可以是多种长度的数字和字母的混合(即使我的示例显示单个字符)。所需数据始终位于每个逗号之间,其中存在逗号(单个数据项除外)。
ID 是数字。
The image below shows an example table of data (columns A to B), and the table on the right (columns E to F) shows my desired output.
There can be any number of the same ID. The data can be replicated many times in the same ID and also include different data.
I need to combine all the different DATA items for each ID.
The data items will be comma separated if more than one data item, and can be a mixture of numbers and letters of multiple lengths (even though my example shows single characters). The required data is always between each comma, where commas exist (except for single data items).
The IDs are numerical.
如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

发布评论
评论(3)
这会根据提供的输入数据生成组合输出。该代码使用Dictionaries
来帮助获取唯一的值集。
Option Explicit
Public Sub Test()
Dim sourceWksht As Worksheet
Set sourceWksht = Application.ActiveWorkbook.Worksheets.("Sheet1")
Dim rawData As Variant
rawData = sourceWksht.Range("A2:B12").Value2
Dim rawInputDictionary As Dictionary
Set rawInputDictionary = New Dictionary
Dim csvValue As String
Dim rawIndex As Long
For rawIndex = LBound(rawData, 1) To UBound(rawData, 1)
csvValue = Trim$(rawData(rawIndex, 2))
If Not rawInputDictionary.Exists(rawData(rawIndex, 1)) And Len(csvValue) > 0 Then
rawInputDictionary.Add rawData(rawIndex, 1), csvValue
ElseIf Len(csvValue) > 0 Then
rawInputDictionary.Item(rawData(rawIndex, 1)) _
= rawInputDictionary.Item(rawData(rawIndex, 1)) & "," & csvValue
End If
Next
GenerateOutput rawInputDictionary, sourceWksht
End Sub
Private Sub GenerateOutput(ByVal rawInputDictionary As Dictionary, ByVal wksht As Worksheet)
Dim outputArray As Variant
ReDim outputArray(1 To rawInputDictionary.Count, 1 To 2)
Dim outputArrayIndex As Long
outputArrayIndex = 1
Dim idKey As Variant
For Each idKey In rawInputDictionary.Keys
outputArray(outputArrayIndex, 1) = idKey
outputArray(outputArrayIndex, 2) = GenerateCombinedData(rawInputDictionary.Item(idKey))
outputArrayIndex = outputArrayIndex + 1
Next
Dim outputRange As Range
Set outputRange = wksht.Range("E2:F" & CStr(rawInputDictionary.Count + 1))
outputRange.Value = outputArray
End Sub
Private Function GenerateCombinedData(ByVal idValues As String) As String
Dim combinedData As String
combinedData = vbNullString
Dim outputDictionary As Dictionary
Set outputDictionary = New Dictionary
Dim valuesArrayIndex As Long
Dim valuesArray As Variant
valuesArray = Split(idValues, ",")
For valuesArrayIndex = LBound(valuesArray) To UBound(valuesArray)
If Not outputDictionary.Exists(valuesArray(valuesArrayIndex)) Then
combinedData = combinedData & valuesArray(valuesArrayIndex) & ","
'Use the outputDictionary 'Keys' to ignore duplicate values
outputDictionary.Add valuesArray(valuesArrayIndex), ""
End If
Next
'Trim the trailing comma
combinedData = Left$(combinedData, Len(combinedData) - 1)
GenerateCombinedData = combinedData
End Function
使用字典字典组合唯一数据和分隔数据
Option Explicit
Sub CombineData()
' Source
Const sName As String = "Sheet1"
Const sDelimiter As String = ", "
' Destination
Const dName As String = "Sheet1"
Const dFirstCellAddress As String = "E2"
Const dDelimiter As String = ", "
' Source range to an array.
Dim Data As Variant
Dim rCount As Long
With ThisWorkbook.Worksheets(sName).Range("A1").CurrentRegion
rCount = .Rows.Count - 1
If rCount < 1 Then Exit Sub ' no data or only headers
Data = .Resize(rCount, 2).Offset(1).Value
End With
' Array to a dictionary of dictionaries.
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
Dim Key As Variant
Dim Item As Variant
Dim r As Long
Dim n As Long
For r = 1 To rCount
Item = CStr(Data(r, 2))
If Not IsError(Item) Then
If Len(Item) > 0 Then
Key = Data(r, 1)
If Not IsError(Key) Then
If Len(Key) > 0 Then
Item = Split(Item, sDelimiter)
If Not dict.Exists(Key) Then
Set dict(Key) = CreateObject("Scripting.Dictionary")
End If
For n = 0 To UBound(Item)
dict(Key)(Item(n)) = Empty
Next n
End If
End If
End If
End If
Next r
rCount = dict.Count
If rCount = 0 Then Exit Sub ' only error values or blanks
' Dictionary of dictionaries to the array.
ReDim Data(1 To rCount, 1 To 2)
r = 0
For Each Key In dict.Keys
r = r + 1
Data(r, 1) = Key
Data(r, 2) = Join(dict(Key).Keys, dDelimiter)
Next Key
' Array to the destination range.
With ThisWorkbook.Worksheets(dName).Range(dFirstCellAddress).Resize(, 2)
.Resize(rCount).Value = Data
.Resize(.Worksheet.Rows.Count - .Row - rCount + 1).Offset(rCount).Clear
End With
MsgBox "Data combined.", vbInformation
End Sub
绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
请使用下一个方法。正如我在评论中所说,它使用字典来提取唯一键和其他四个数组来保留中间值并构建最终值。以下代码能够处理两种(可能的)分隔符:逗号“,”和逗号后跟一个或多个空格“,”,“,”,“,”。它仅在内存中工作并且应该非常快,即使对于大范围也是如此:
Please, use the next way. As I said in my comment, it uses a dictionary to extract the unique keys and other four arrays to keep intermediary values and build the final one. The following code is able to deal with both (possible) separators: comma "," and comma followed by one or more spaces ", ", ", ", " ,". It works only in memory and should be very fast, even for large ranges: