雯桦 发表于 2021-11-10 20:00:00

如何在一个单元格里显示所有的查询结果,用/分隔

求助各位大侠,
如何在一个单元格里显示所有的查询结果,用/分隔,详见附件。
用函数最好,可以用辅助列实现。实在不行,用VBA实现也可以。我用的是2010版EXCEL,找下了,没有CONCAT、TEXTJOIN函数。
贴子快要沉了,重新发一个,感谢。拜谢各位了。

沙拉丁 发表于 2021-11-19 17:15:55

非常感谢,贴子看了一遍,非常用心,写得也不乏味,受教了。

狮子座流星雨 发表于 2021-12-18 05:19:08

VBA
Sub 筛选复制()
Application.CutCopyMode = False
Range("B:B").AdvancedFilter Action:=xlFilterCopy _
, CriteriaRange:=Range("H2"), CopyToRange:=Range("H2"), Unique:=True
End Sub
Sub 合并()
Dim rngCell As Range, rngResult As Range, s As String, c As Range, i%
Dim strFirstAddress As String
For i = 3 To .End(xlUp).Row
Set rngCell = Range("B2:B16").Find(What:=Cells(i, 8), After:=Range("B2:B16").Cells(1), LookIn:=xlValues, LookAt:=xlPart)
If Not rngCell Is Nothing Then
    strFirstAddress = rngCell.Address
    Set rngResult = rngCell
    Do
      Set rngResult = Application.Union(rngResult, rngCell)
      Set rngCell = Range("B2:B16").FindNext(rngCell)
    Loop While rngCell.Address <> strFirstAddress
    rngResult.Offset(, 2).Select
    If TypeName(Selection) = "Range" Then
      For Each c In Selection
      s = s & "/" & c.Value
      Next
    End If
Cells(i, 9) = VBA.Mid(s, 2, Len(s))
End If
s = ""
Next i
Set rngCell = Nothing
Set rngResult = Nothing
End Sub

心动神逸 发表于 2022-1-3 15:38:18

抱歉,前面的包是保存前上传的,重新上传。

猫耳萌萌 发表于 2022-1-15 17:38:08

谢谢,这么长的VBA,肯定花费了不少时间,感谢。

陈年老窖 发表于 2022-1-18 00:19:13

谢啦,这个也不错哟

时间思维 发表于 2022-2-3 01:23:14

因为爱,新版本Excel函数unique与filter、textjoin可以快速解决,而,VBA就繁复点。
页: [1]
查看完整版本: 如何在一个单元格里显示所有的查询结果,用/分隔