我有这张表,上面有设备和相应的属性:
我想在此表中查找设备的值并将相应的属性值连接到一个单元格中,以便结果如下所示:
我已经尝试过使用这样的用户定义函数:
Function CusVlookup(lookupval, lookuprange As Range, indexcol As Long)
Dim x As Range
Dim result As String
result = ""
For Each x In lookuprange
If x = lookupval Then
result = result & " " & x.Offset(0, indexcol - 1)
End If
Next x
CusVlookup = result
End Function
CusVlookup 效果很好,但它太重了,我有 2000 多个独特的设备值,所以 excel 只是压碎或计算时间太长
我也用了TEXTJOIN函数数组公式,结果一样,速度很慢,excel碾压
我需要使用线路断路器 (
vbCrLf
) 加入单元格是否有 VBA 代码可以实现相同的目标?
谢谢!
最佳答案
您可以将 VBA 与字典对象一起使用,也可以使用 Power Query
又名 Get&Transform
自 Excel 2010 以来一直可用
在 2016 年,导航到数据选项卡和从表/范围获取(在早期版本中可能会有所不同)。
当 PQ UI 打开时,选择
=Table.Column([Grouped],"Properties")
Wrap Text
属性并自动适应列。之后,您可以在需要时更新查询,并且这些属性将保持不变。 结果使用您的数据:
或者您可以使用 VBA:
'Set Reference to Microsoft Scripting Runtime
' or use late-binding to `Scripting.Dictionary`
Option Explicit
Sub Connect()
Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
Dim vSrc As Variant, vRes As Variant
Dim D As Dictionary, COL As Collection, Key As Variant
Dim I As Long, V As Variant
Dim S As String
'Set source and results worksheets and ranges
Set wsSrc = Worksheets("Source")
Set wsRes = Worksheets("Results")
Set rRes = wsRes.Cells(1, 1)
'read source data into VBA array for fastest processing
With wsSrc
vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 2).End(xlUp))
End With
'Collect properties into dictionary item keyed to Equipment
Set D = New Dictionary
D.CompareMode = TextCompare
For I = 2 To UBound(vSrc, 1)
Key = vSrc(I, 1)
If Not D.Exists(Key) Then
Set COL = New Collection
COL.Add Item:=vSrc(I, 2)
D.Add Key:=Key, Item:=COL
Else
D(Key).Add vSrc(I, 2)
End If
Next I
'Write new stuff into VBA results array
ReDim vRes(0 To D.Count, 1 To 2)
'Headers
vRes(0, 1) = "Equipment"
vRes(0, 2) = "Properties"
'Populate
I = 0
For Each Key In D.Keys
I = I + 1
S = ""
vRes(I, 1) = Key
For Each V In D(Key) 'iterate through the collection
S = S & vbLf & V
Next V
vRes(I, 2) = Mid(S, 2) 'remove the leading LF
Next Key
'write results to worksheet and format
Application.ScreenUpdating = False
Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))
With rRes
.EntireColumn.Clear
.Value = vRes
.ColumnWidth = 255
With .Rows(1)
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
.Columns(2).WrapText = True
.Columns(1).VerticalAlignment = xlCenter
.EntireColumn.AutoFit
.EntireRow.AutoFit
.Style = "Output"
End With
End Sub
关于excel - 查找值并将相应的值连接到一个单元格中(使用换行符 vbCrLf),我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/55901778/