Question

我正在查看我设置以下Excel的问题：

1 Mainstreet 1
1 Mainstreet 2
1 Yorkstreet 1
1 Yorkstreet 2

A列中的1表示，B表示街道中的数字。

现在我想要一个Vlookup，它会搜索1并发出：

Mainstreet 1,2，Yorkstreet 1,2

我已经在搜索博客的帮助下设置了一个代码（请参阅问题的结尾），但是它已经给出了。

Mainstreet 1,2，Yorkstreet 2，

我认为问题在于“removedupes2”公式，该公式还将Yorkstreet中的2标识为文本，并且consequentyl将其删除。

有没有人有线索？：）

提前谢谢你：）

在下面找到我的代码：

    Function StrSort(ByVal sInp As String, _
    Optional bDescending As Boolean = False) As String
     ' sorts a comma-delimited string
    Dim asSS()  As String ' substring array
    Dim sSS     As String ' temp string for exchange
    Dim n       As Long
    Dim i       As Long
    Dim j       As Long

    asSS = Split(sInp, ",")
    n = UBound(asSS)

    For i = 0 To n
        asSS(i) = Trim(asSS(i))
    Next

    If n <= 1 Then
        StrSort = sInp
    Else
        For i = 0 To n - 1
            For j = i + 1 To n
                If (asSS(j) < asSS(i)) Xor bDescending Then
                    sSS = asSS(i)
                    asSS(i) = asSS(j)
                    asSS(j) = sSS
                End If
            Next j
        Next i
        StrSort = Join(asSS, ", ")
    End If
End Function

Function RemoveDupes2(txt As String, Optional delim As String = " ") As String
    Dim x

    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For Each x In Split(txt, delim)
            If Trim(x) <> "" And Not .exists(Trim(x)) Then .Add Trim(x), Nothing
        Next
        If .Count > 0 Then RemoveDupes2 = Join(.keys, delim)
    End With
End Function

Function Myvlookup(lookupval, lookuprange As Range, indexcol As Long)

Dim r As Range
Dim result As String
Dim result2 As String
Dim result3 As String
result = ""
For Each r In lookuprange
    If r = lookupval Then
        result = result & ", " & r.Offset(0, indexcol - 1)
    End If
Next r

result2 = Right(result, Len(result) - 2)

result3 = StrSort(result2)
Myvlookup = RemoveDupes2(result3)
End Function

Answer 1

问题在于您的RemoveDupes2()功能

主要是因为它处理为keys街道名称（“Mainstreet”，“Yorkstreet”，...）和数字（“1” ，“2”，..）单独以便在第一次（例如：从“Mainstreet 1,2，......”）添加“1”后，再创建字典，进一步在txt中出现“1”（例如“Yorkstreet 1,2”）将不会通过Not .exists(Trim(x))检查，因此不会被添加到字典keys

虽然采用“”作为分隔符是你得到“Yorkstreet 2”

的原因

因为第一次出现的“2”实际上是来自“Mainstreet 1,2”的“2”（即它被“捕获”与具有“”作为Split() delimeter参数的相邻逗号一起），而第二个是来自“Yorkstreet 1,2”的“纯”“2”

您可能希望采用以下RemoveDupes2()代码

Function RemoveDupes2(txt As String, Optional delim As String = " ") As String
    Dim x
    Dim streetsDict As New Scripting.Dictionary
    Dim street As String, number As String

    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For Each x In Split(txt, ", ")
            If Trim(x) <> "" Then
                street = Split(Trim(x), " ")(0)
                number = Split(Trim(x), " ")(1)
                If Not .Exists(street) Then
                    .Add street, New Scripting.Dictionary
                    .Item(street).Add number, Nothing
                Else
                    If Not .Item(street).Exists(number) Then .Item(street).Add number, Nothing
                End If
            End If
        Next
        If .Count > 0 Then
            For Each x In .Keys
                RemoveDupes2 = RemoveDupes2 & x & " " & Join(.Item(x).Keys, ", ") & ", "
            Next x
            RemoveDupes2 = Left(RemoveDupes2, Len(RemoveDupes2) - 2)
        End If
    End With
End Function

删除重复的VBA Vlookup for Adresses

1 个答案: