一对多匹配，多个结果用逗号隔开

andy117

ykcbf1100 发表于 2024-8-8 09:39
你这都不用字典

不调整1362的顺序呢

ykcbf1100

andy117 发表于 2024-8-8 10:02
不调整1362的顺序呢

都是一样的数据，你调整顺序有意义吗？

Lost_in_Star

limonet 发表于 2023-7-26 20:40
SQL法：Where\join等
公式法：=TEXTJOIN(",",,FILTER(数据源!B$2:B$7,数据源!A$2:A$7=A4))

如果是指定列而不是ID该怎么写？非常感谢！

andy117

ykcbf1100 发表于 2024-8-8 10:10
都是一样的数据，你调整顺序有意义吗？

我现在操作的表需要按这个逻辑。数据量有点大

ykcbf1100

andy117 发表于 2024-8-8 13:18
我现在操作的表需要按这个逻辑。数据量有点大

改一下吧。

ykcbf1100

再改一下。

1. Sub ykcbf()   '//2024.8.8
   
2.     Dim arr, brr
   
3.     Application.ScreenUpdating = False
   
4.     arr = Sheets("数据源").UsedRange
   
5.     ReDim brr(1 To UBound(arr), 1 To 2)
   
6.     r = Cells(Rows.Count, 3).End(3).Row
   
7.     zrr = Cells(4, 3).Resize(r - 3, 1)
   
8.     For x = 1 To UBound(zrr)
   
9.         For i = 2 To UBound(arr)
   
10.             If zrr(x, 1) = arr(i, 1) Then
    
11.                 m = m + 1
    
12.                 brr(m, 1) = arr(i, 1)
    
13.                 brr(m, 2) = arr(i, 2)
    
14.             End If
    
15.         Next
    
16.     Next
    
17.     With Sheets("结果")
    
18.         .[a4:b10000] = ""
    
19.         .Range("a4").Resize(m, 2) = brr
    
20.     End With
    
21.     Set d = Nothing
    
22.     Application.ScreenUpdating = True
    
23.     MsgBox "OK！"
    
24. End Sub
    

复制代码

MR_PP

1. Sub test()
   
2.     Dim ws As Worksheet
   
3.     Dim dict As Object
   
4.     Dim key As Variant
   
5.     Dim i As Long, lastRow As Long
   
6.     Dim result As String
   
7.    
   
8.     Set ws = Worksheets("数据源")
   
9.     Set dict = CreateObject("Scripting.Dictionary")
   
10.    
    
11.     lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
12.    
    
13.     For i = 1 To lastRow
    
14.         key = ws.Cells(i, 1).Value
    
15.         If Not dict.exists(key) Then
    
16.             dict.Add key, ws.Cells(i, 2).Value
    
17.         Else
    
18.             dict(key) = dict(key) & ", " & ws.Cells(i, 2).Value
    
19.         End If
    
20.     Next i
    
21.    
    
22.     i = 1
    
23.     For Each key In dict.keys
    
24.         ws.Cells(i, 3).Value = key
    
25.         ws.Cells(i, 4).Value = dict(key)
    
26.         i = i + 1
    
27.     Next key
    
28. End Sub
    
29. 
    

复制代码

andy117

ykcbf1100 发表于 2024-8-8 14:57
改一下吧。

谢谢！回去看一下~~~