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

Question

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

有人可以帮忙吗？

Answer 1

StackOverflow 不是编码服务，您应该提供您的代码，但在这种情况下，我对这项任务很感兴趣。这是一个可能的解决方案。 运行 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 编写的，可以在 here 找到。它假定多项选择名称在“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