Realmente, sem ver a planilha fica difícil... de qualquer forma, pela sua descrição bolei alguma coisa, vê se funciona aí.
Obs.: 1. Não considera acentos (João # Joao).
[edição] 2. Dependendo da quantidade de dados, o código pode ser bem demorado (pois verifica célula por célula, palavra por palavra). Se você rodar com 2 intervalos de 12.000 linhas cada, vai demorar muito.
Código: Selecionar todosSub Parkeless()
Dim Área_completo As Range
Dim Área_incompleto As Range
Dim cell As Range
Dim cell_completa As Range
Dim cell_texto As Variant
Dim cell_texto_completo As Variant
Dim campo As String
Dim i As Integer, i_completo As Integer
Dim semelhante As Integer
Dim critérios As Integer
'Definições do usuário
Set Área_incompleto = Application.InputBox("Selecione os nomes incompletos (pode ser coluna inteira).", "Dados Incompletos", Type:=8)
Set Área_completo = Application.InputBox("Selecione os nomes completos (pode ser coluna inteira).", "Dados Completos", Type:=8)
critérios = Application.InputBox("Número de critérios (recomendado:2)", "Critérios", 2)
Application.ScreenUpdating = False
'Definir área de análise
Application.Worksheets.Add
Área_incompleto.Copy Range("A1")
'Para cada nome incompleto
For Each cell In Range("A:A").SpecialCells(xlCellTypeConstants)
cell_texto = Split(cell, " ")
'Fazer para cada nome completo
For Each cell_completa In Área_completo.SpecialCells(xlCellTypeConstants)
cell_texto_completo = Split(cell_completa, " ")
'Para cada palavra na célula incompleta
For i = 0 To Application.CountA(cell_texto) - 1
'Ignorar até 3 letras (do, das, dos, das, etc)
If Len(cell_texto(i)) > 3 Then
'Para cada palavra na célula completa
For i_completo = 0 To Application.CountA(cell_texto_completo) - 1
'Se for igual, somar um 'semelhante'
If StrConv(cell_texto(i), vbProperCase) = StrConv(cell_texto_completo(i_completo), vbProperCase) Then: semelhante = semelhante + 1
Next i_completo
End If
Next i
'Se palavras semelhantes somaram duas, marcar o nome completo na próxima coluna disponível
If semelhante >= critérios Then
cell.Offset(0, Application.CountA(cell.EntireRow)) = cell_completa
End If
'Zerar
'Próxima palavra completa
semelhante = 0
Next cell_completa
jump:
semelhante = 0
Next cell
Rows("1:1").Insert
Range("A1") = "Nome Incompleto"
Range("B1") = "Variações"
Columns("A:ZZ").EntireColumn.AutoFit
Application.ScreenUpdating = True
MsgBox "Relatório concluído!", vbInformation
End Sub