Question

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

任何人都可以提供帮助吗？

Answer 1

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

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的学生编写，可以找到here。它假设多项选择名称在列＃B; B＆＃34;那＆＃34; Jon＆＃34;和＃34;史密斯＆＃34;是硬编码的 - 但可以从代码中稍微改变的另一列中提取。

B栏包含：乔恩史密斯 Smith Jon Junior 史密斯乔恩

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

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

2 个答案: