我知道你正在寻找一个完全匹配。但是，您可能需要考虑尝试 FuzzyMatch。
http://code.google.com/p/fast-vba-fuzzy-scoring-algorithm/source/browse/trunk/Fuzzy1
您可以将此函数下载/导入到您的工作簿，然后使用您正在比较的 2 个字符串/名称调用它，它将返回一个分数。
如果我是你，我会遍历所有可能的名字并获得最高分。如果您正在寻找完全匹配，那么在您的情况下将是 100%。
这将为您的程序增加时间，但它可能会对您有所帮助。
===已编辑
========= 这是代码。将此添加到您的模块中。
Option Explicit
Public Declare Function GetTickCount Lib "kernel32.dll" () As Long
'To be placed in the Declarations area
'_____________________________________
Sub TestFuzzy()
Dim t As Long, a As Long, i As Long
t = GetTickCount
For i = 1 To 100000
a = Fuzzy("Sorin Sion", "Open Source")
Next
Debug.Print "Similarity score: " & a & "; " & i - 1 & " iterations took " & _
GetTickCount - t & " milliseconds"
End Sub
'TestFuzzy's result should look like:
'Similarity score: 0.3; 100000 iterations took 2094 milliseconds
'The test was done on an Intel processor at 3.2GHz
'_____________________________________
Public Function Fuzzy(ByVal s1 As String, ByVal s2 As String) As Single
Dim i As Integer, j As Integer, k As Integer, d1 As Integer, d2 As Integer, p As Integer
Dim c As String, a1 As String, a2 As String, f As Single, o As Single, w As Single
'
' ******* INPUT STRINGS CLEANSING *******
'
s1 = UCase(s1) 'input strings are converted to uppercase
d1 = Len(s1)
j = 1
For i = 1 To d1
c = Mid(s1, i, 1)
Select Case c
Case "0" To "9", "A" To "Z" 'filter the allowable characters
a1 = a1 & c 'a1 is what remains from s1 after filtering
j = j + 1
End Select
Next
If j = 1 Then Exit Function 'if s1 is empty after filtering
d1 = j - 1
s2 = UCase(s2)
d2 = Len(s2)
j = 1
For i = 1 To d2
c = Mid(s2, i, 1)
Select Case c
Case "0" To "9", "A" To "Z"
a2 = a2 & c
j = j + 1
End Select
Next
If j = 1 Then Exit Function
d2 = j - 1
k = d1
If d2 < d1 Then
'to prevent doubling the code below s1 must be made the shortest string,
'so we swap the variables
k = d2
d2 = d1
d1 = k
s1 = a2
s2 = a1
a1 = s1
a2 = s2
Else
s1 = a1
s2 = a2
End If
If k = 1 Then 'degenerate case, where the shortest string is just one character
If InStr(1, s2, s1, vbBinaryCompare) > 0 Then
Fuzzy = 1 / d2
Else
Fuzzy = 0
End If
Else '******* MAIN LOGIC HERE *******
i = 1
f = 0
o = 0
Do 'count the identical characters in s1 and s2 ("frequency analysis")
p = InStr(1, s2, Mid(s1, i, 1), vbBinaryCompare)
'search the character at position i from s1 in s2
If p > 0 Then 'found a matching character, at position p in s2
f = f + 1 'increment the frequency counter
s2 = Left(s2, p - 1) & "~" & Mid(s2, p + 1)
'replace the found character with one outside the allowable list
'(I used tilde here), to prevent re-finding
Do 'check the order of characters
If i >= k Then Exit Do 'no more characters to search
If Mid(s2, p + 1, 1) = Mid(s1, i + 1, 1) Then
'test if the next character is the same in the two strings
f = f + 1 'increment the frequency counter
o = o + 1 'increment the order counter
i = i + 1
p = p + 1
Else
Exit Do
End If
Loop
End If
If i >= k Then Exit Do
i = i + 1
Loop
If o > 0 Then o = o + 1 'if we got at least one match, adjust the order counter
'because two characters are required to define "order"
finish:
w = 2 'Weight of characters order match against characters frequency match;
'feel free to experiment, to get best matching results with your data.
'If only frequency is important, you can get rid of the second Do...Loop
'to significantly accelerate the code.
'By altering a bit the code above and the equation below you may get rid
'of the frequency parameter, since the order counter increments only for
'identical characters which are in the same order.
'However, I usually keep both parameters, since they offer maximum flexibility
'with a variety of data, and both should be maintained for this project
Fuzzy = (w * o + f) / (w + 1) / d2
End If
End Function
===================
所以一旦你有了它，然后添加这样的东西。
Dim strA, strB, hiScore(1 to 3), tempScore
With Thisworkbook.ActiveSheet
For a = 1 to .Usedrange.Rows.Count ' Scans Column 1
strA = .cells(a,1) ' Barclays Aggregate Index
For b = 1 to .usedrange.rows.count ' Compares Col 1 to Col 2
strB = .cells(b,2) ' Barclays Aggregate Other Index
tempScore = Fuzzy(strA, strB)
If tempScore > hiScore then
hiScore(1) = tempScore
hiScore(2) = a
hiScore(3) = b
End If
Next b
' Do your Action with the Best Match Here
If hiScore(1) = 1 then ' (100% - perfect match)
' Copies col 3 from the row that the best strB match was on
' to col 4 from the row strA was on
.Cells(a,4) = .Cells(hiScore(3),3)
End If
' ====
' Reset Variables
hiScore = ""
tempScore = ""
Next a
End with