[英]VBA code to return multiple lookup values in one comma separated works but crashes if there's an empty cell
I've found this code online which works like vlookup function but returns multiple data in one cell separated by comma and it works most of the time.我在网上找到了这段代码,它的工作方式类似于 vlookup function,但在一个单元格中返回多个数据,这些数据以逗号分隔,并且大部分时间都有效。 But when there's a blank cell in the lookup value it causes a crash.
但是当查找值中有一个空白单元格时,它会导致崩溃。 It takes a long time to process too.
处理的时间也很长。 I tried to tinker with it but I'm completely new to VBA coding.
我试着修改它,但我对 VBA 编码完全陌生。 I was wondering if anyone could please help me fix the issue and maybe optimize the code a little so it doesn't crash or take as long.
我想知道是否有人可以帮我解决这个问题,也许可以稍微优化一下代码,这样它就不会崩溃或花费很长时间。 Lookup value Table array
查找值表数组
Here's the code这是代码
Function MultiVLookUp(LookupValue As String, LookupRange As Range, ColumnNumber As Integer, Char As String)
Dim I As Long
Dim xRet As String
For I = 1 To LookupRange.Columns(1).Cells.Count
If LookupRange.Cells(I, 1) = LookupValue Then
If xRet = "" Then
xRet = LookupRange.Cells(I, ColumnNumber) & Char
Else
xRet = xRet & "" & LookupRange.Cells(I, ColumnNumber) & Char
End If
End If
Next
MultiVLookUp = Left(xRet, Len(xRet) - 1)
End Function
Thanks in advance.提前致谢。
Char
(Delimiter) argument, as optional (default) to your 'favorite' ", "
so you don't need to add it anymore.Char
(定界符)参数的参数设置为可选(默认)到您的“收藏夹” ", "
因此您不需要添加它了。Option Explicit
Function MultiVLookUp( _
ByVal LookupValue As String, _
ByVal LookupRange As Range, _
ByVal ColumnNumber As Long, _
Optional ByVal Char As String = ", ") _
As String
If Len(LookupValue) = 0 Then Exit Function
Dim lData As Variant
Dim vData As Variant
Dim lrCount As Long
With LookupRange
lrCount = .Rows.Count
If lrCount = 1 Then
ReDim lData(1 To 1, 1 To 1): lData(1, 1) = .Columns(1).Value
ReDim vData(1 To 1, 1 To 1): vData(1, 1) _
= .Columns(ColumnNumber).Value
Else
lData = .Columns(1).Value
vData = .Columns(ColumnNumber).Value
End If
End With
Dim r As Long
Dim rString As String
For r = 1 To lrCount
If CStr(lData(r, 1)) = LookupValue Then
rString = rString & CStr(vData(r, 1)) & Char
End If
Next r
If Len(rString) = 0 Then Exit Function
MultiVLookUp = Left(rString, Len(rString) - Len(Char))
End Function
Im not really sure the point of this macro considering it just outputs the same value repeatedly but here ya go.我不太确定这个宏的意义,因为它只是重复输出相同的值,但这里是 go。
Sub main()
' ws is the worksheet object referencing "Sheet1"
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
' Top Left (r, c) (r, c) Bottom Right
Dim rng As Range: Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(6, 6))
Dim lookupValue As String: lookupValue = ""
Dim outStr As String: outStr = rangeValuesToString(rng, lookupValue)
Debug.Print outStr
End Sub
Function rangeValuesToString(rng As Range, lookupValue As String) As String
Dim topRow As Integer: topRow = rng.Row
Dim botRow As Integer: botRow = rng.Row - 1 + rng.Rows.Count
Dim leftCol As Integer: leftCol = rng.Column
Dim rightCol As Integer: rightCol = rng.Column - 1 + rng.Columns.Count
Dim i As Integer, j As Integer
Dim outStr As String: outStr = ""
' Iterates through each column moving left to right
For i = leftCol To rightCol
For j = topRow To botRow
If rng.Cells(j, i).Value = lookupValue Then
outStr = outStr & rng.Cells(j, i).Value & ", "
End If
Next j
Next i
rangeValuesToString = Left(outStr, Len(outStr) - 2)
End Function
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.