无论顺序如何，比较单元格中的字符串

Question

我正在寻找一些代码帮助来比较 2 个字符串并根据它们与原始标准的匹配对它们进行排名。代码应该忽略顺序，例如A1包含单词"Jon Smith"（原始值），和B1 "Smith Jon"，它们是相同的排名。但是，如果 C1 包含 "Jon Smith Junior"，则其排名应低于 "Jon Smith" 或 "Smith Jon"。

有人可以帮忙吗？

Answer 1

Whosebug 不是编码服务，您应该提供您的代码，但在这种情况下，我对该任务感兴趣。这是一个可能的解决方案。运行 checkme - 它只需要两个字符串并将它们拆分成数组。然后它计算 arrOne 中的值出现在 arrTwo 中的次数。有了这些信息，它就会给出某种结果。

Option Explicit

Public Function CompareTwo(strOne As String, strTwo As String) As Double

    Dim arrOne      As Variant
    Dim arrTwo      As Variant
    Dim varOne      As Variant
    Dim varTwo      As Variant

    Dim lngCounter  As Long

    arrOne = Split(strOne)
    arrTwo = Split(strTwo)

    For Each varOne In arrOne
        For Each varTwo In arrTwo
            If varOne = varTwo Then
                lngCounter = lngCounter + 1
            End If
        Next varTwo
    Next varOne

    CompareTwo = lngCounter / (UBound(arrOne) + 1)

End Function

Public Sub CheckMe()

    Debug.Print CompareTwo("Smith Jon", "Jon Smith")
    Debug.Print CompareTwo("Jon Smith Junior", "Jon Smith")
    Debug.Print CompareTwo("Jon Smith Junior Ale 6", "Jon Smith Ale 6")

End Sub

Answer 2

我想到了这个。它创建了两个数组，一个是在 B 列的给定单元格中找到两个键名，另一个是 arr1 的每个数组元素中有多少个单词。然后它将这两个数组发送到一个Sort2 Sub，这是成员Gary的Student写的，可以找到。它假定多项选择名称在 "B" 列中，并且 "Jon" 和 "Smith" 是硬编码的 - 但可以从另一列中提取，只需对代码稍作更改。

B 列包含：乔恩·史密斯小史密斯乔恩史密斯乔恩

Sub create2arr()
Dim myArr() As Variant, name1 As String, name2 As String, firstMarker As Boolean, myArrayCounter As Long, myArray2Counter As Long
Dim splitArr() As String, wordCountArr() As Variant

name1 = "Jon"
name2 = "Smith"
ReDim myArr(1 To 1)
ReDim myArr2(1 To 1)
ReDim wordCountArr(1 To 1)

myArrayCounter = 1
myArray2Counter = 1

For I = 1 To 3
   splitArr = Split(Sheet6.Range("B" & I))
   For J = LBound(splitArr) To UBound(splitArr)
        If UCase(splitArr(J)) = UCase(name1) Or UCase(splitArr(J)) = UCase(name2) Then
                If firstMarker = True Then
                    myArr(myArrayCounter) = Sheet6.Range("B" & I)
                    wordCountArr(myArrayCounter) = UBound(splitArr) + 1
                    myArrayCounter = myArrayCounter + 1
                    ReDim Preserve myArr(1 To myArrayCounter)
                    ReDim Preserve wordCountArr(1 To myArrayCounter)
                    firstMarker = False
                Else
                    firstMarker = True
                End If
        End If
    Next J
Next I

For I = 1 To UBound(myArr)
Debug.Print myArr(I)
Next I

Call sort2(wordCountArr, myArr)

For I = 1 To UBound(myArr)
Debug.Print myArr(I)
Next I


End Sub

Sub sort2(key() As Variant, other() As Variant)
Dim I As Long, J As Long, Low As Long
Dim Hi As Long, Temp As Variant
    Low = LBound(key)
    Hi = UBound(key)

    J = (Hi - Low + 1) \ 2
    Do While J > 0
        For I = Low To Hi - J
          If key(I) > key(I + J) Then
            Temp = key(I)
            key(I) = key(I + J)
            key(I + J) = Temp
            Temp = other(I)
            other(I) = other(I + J)
            other(I + J) = Temp
          End If
        Next I
        For I = Hi - J To Low Step -1
          If key(I) > key(I + J) Then
            Temp = key(I)
            key(I) = key(I + J)
            key(I + J) = Temp
            Temp = other(I)
            other(I) = other(I + J)
            other(I + J) = Temp
          End If
        Next I
        J = J \ 2
    Loop
End Sub

无论顺序如何，比较单元格中的字符串

Compare strings in a cell no matter the sequence

string

excel

vba

string-comparison