Function compareStrings(string1 As String, string2 As String) As Boolean
' Replace multiple spaces and tabs
Dim regX As Object
Set regX = CreateObject("VBScript.RegExp")
regX.Pattern = "\s{2,}"
regX.Global = True
string1 = regX.Replace(string1, " ")
string2 = regX.Replace(string2, " ")
' Split both strings into single words
Dim string1Tokens() As String, string2Tokens() As String
string1Tokens = Split(string1, " ")
string2Tokens = Split(string2, " ")
' If we have a different number of words we don't need to continue.
If UBound(string1Tokens) <> UBound(string2Tokens) Then Exit Function
Dim i1 As Long, i2 As Long
For i1 = LBound(string1Tokens) To UBound(string1Tokens)
Dim wordFound As Boolean
wordFound = False
For i2 = LBound(string2Tokens) To UBound(string1Tokens)
If string1Tokens(i1) = string2Tokens(i2) Then
wordFound = True
Exit For
End If
Next
' Word of first string was not found.
If Not wordFound Then Exit Function
Next
' All words where found
compareStrings = True
End Function
Function name_compare(n1 As String, n2 As String) As Boolean
n1 = Join(sort_array(Split(UCase(n1), " ")), " ")
n2 = Join(sort_array(Split(UCase(n2), " ")), " ")
name_compare = (n1 = n2)
End Function
Function sort_array(arr)
Dim i As Long, j As Long, temp As String
For i = LBound(arr) To UBound(arr) - 1
For j = i + 1 To UBound(arr)
If arr(i) > arr(j) Then
temp = arr(j)
arr(j) = arr(i)
arr(i) = temp
End If
Next j
Next i
sort_array = arr
End Function
您可以像这样使用此函数:
Const name1 As String = "abcd def"
Const name2 As String = "def abcd"
Debug.Print name_compare(name1, name2)
3条答案
按热度按时间b09cbbtk1#
我假设你想比较两个字符串中的单个单词,但顺序不限。Excel或VBA中没有内置函数。
下面的函数将两个字符串拆分为单个单词(使用
split
-函数),并检查第一个字符串中的每个单词是否也出现在第二个字符串中。我添加了一个小的正则表达式代码来去除两个字符串中的多个空格或制表符,如果您确定单词之间总是只有一个空格,则可以删除这些行lmvvr0a82#
另一种方法是对每个字符串的字符代码求和,然后比较它们的值。首先检查两个字符串的长度,如果它们不相同,就可以避免这一切。
老实说,我不知道这在哪里会有用
第一个
qv7cva1a3#
正如Kostas在评论中提到的,拆分-排序-连接字符串可以让你比较两个字符串,而不管组成这些字符串的单词的顺序如何:
您可以像这样使用此函数:
结果: