3

列 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
4

3 に答える 3

3

みんなの助けを借りて、正しい方法を見つけました。ここにあります:

        If InStr(1, Cells(d, 4), Left(str, aux)) = 1 Then
            Cells(a, 2) = Cells(d, 4)
            Exit For
        ElseIf InStr(Cells(d, 4), Right(str, aux)) + strLen - aux = strLen Then
            Cells(a, 2) = Cells(d, 4)
            Exit For
        End If
于 2013-09-26T23:44:52.540 に答える
0

InStr 関数を使用してご自身で問題を解決されたことを嬉しく思います。コードがうまく機能しなかった理由は、名前の短縮バージョンと完全な長さのバージョンを比較していたためです。以前のコードを次のように変更すると、より多くの一致が見つかります。

            If Left(Cells(d, 4), aux) = Left(str, aux) Then
                Cells(a, 2) = Cells(d, 4)
                Exit For
            ElseIf Right(Cells(d, 4), aux) = Right(str, aux) Then
                Cells(a, 2) = Cells(d, 4)
                Exit For
            End If
于 2013-09-26T23:59:05.580 に答える
0

これは絶対にテストされていません

明日書き直してクリーンアップしますが、これは正しい単語に一致していることを本当に知るための基本的な方法です. もう少し時間がかかるかもしれません、明日はかなりスピードアップしますが、今のところ、これは言葉の有効性をテストするためのクローゼットの方法です

'Go through all possibly typod words
For each rngTestCell in Range("yourlist")

   'For each possibly typod word test if against every correct value
    For each rngCorrectedValue in Range("ListOfCorrectValues")

        'start by testing length to weed out most values quick
        'Test any words that are within 3 letters of each other, can be less
        'could add a tet for first and last letters match also before starting 
        'to match every letter also, just a top level weeding of words
        If (Len(rngTestCell) - Len(rngCorrectedValue)) < 3 Then

           'loop each letter in the words for match keep a record of how many are matched
           for i = 1 to Len(rngTestCell)

                If rngTestCell.Character(i,1) = rngCorrectedValue.Characters(i,1) Then
                     NumberOfMatches = NumberOfMatches + 1
                End If

            next i

            'if enough of the letters match replace the word, this will need updating because
            'i feel using a ratio of more then 10% of the words match then replace
            'but for now if more then 2 letters don't match then it isn't a match
            If (Len(rngTestCell) - NumberOfMatches) > 2 Then 'Less then 2 letters are different
                rngTestCell.Offset(,1).Value = rngCorrectedValue.Value
                Exit Loop
            End If

        End If

    Next rngCorrectedValues

Next rngTestCell 
于 2013-09-27T00:54:21.683 に答える