列 A と D の 2 つのセル (文字列) を比較し、部分一致が見つかった場合は、対応する B セルに D セルの値を書き留める次のコードを開発しました。
Sub CompareAndGuess()
Dim strLen, aux As Integer
Dim max1, max2 As Long
Dim str As String
Range("A1").Select
Selection.End(xlDown).Select
max1 = ActiveCell.Row
Range("D1").Select
Selection.End(xlDown).Select
max2 = ActiveCell.Row
For a = 2 To max1
str = Cells(a, 1)
str = StrConv(str, vbUpperCase)
strLen = Len(str)
aux = strLen
For l = 3 To strLen
For d = 2 To max2
If Cells(d, 4) = Left(str, aux) Then
Cells(a, 2) = Cells(d, 4)
Exit For
ElseIf Cells(d, 4) = Right(str, aux) Then
Cells(a, 2) = Cells(d, 4)
Exit For
End If
Next d
aux = aux - 1
If Cells(a, 2) <> "" Then
Exit For
End If
Next l
Cells(a, 2).Select
Next a
End Sub
実行すると、コードは50行のうち1行しか推測しないのに対し、少なくとも40行程度は一致するはずなので、誰でも問題の場所を見つけるのを手伝ってもらえますか?
お願いします、私は本当にそこにエラーを見つけることができません. 必要に応じて、私の問題に対する別の解決策を提案してください。
私が分析しているデータのサンプルは次のとおりです: Names with Typos:-
Jatiuca
Pajuara
Poco
Santa Luzia
Pajucara
Domingos Acacio
Jaragua
Stella Maris
P Verde
Tabuleiro dos Martin
Gruta Lourdes
Brasilia
Centro Historico
Monumento
Tabuleiro dos Martins
このリストで検索するタイプミスのある名前:-
JARAGUÁ
TABULEIRO DO MARTINS
CENTRO
BRASÍLIA
CACIMBAS
JATIÚCA
CAITITUS
PAJUÇARA
CANAÃ
PONTA VERDE
CANAFÍSTULA
POÇO
CAPIATÃ
CAVACO
SANTA LÚCIA