web-dev-qa-db-ja.com

ExcelVBAプロジェクトで類似しているが正確ではないテキスト文字列を照合する

さて、私はこれに対する解決策を見つけようとしてきましたが、私はそれができないようです。問題をきちんと分解することすらできません。これがアイデアです。

行数の多い2枚のシートがあります（1枚は800枚、もう1枚は300,000枚）。各行には名前列が含まれ、次にこの名前に関する情報を含むいくつかの列が含まれます。各シートには異なる種類の情報があります。

この2つのシートを、両方の[名前]列に基づいてマスターシートに統合したいので、統合機能はこれに最適です。問題は、名前が完全に一致しないことです。

たとえば、Sheet1には

「CompanyB.V。」、「Info＃1」
"会社合計"、 "情報＃2"
"Company Ltd"、 "Info＃3"

シート2には

「CompanyandCo。」、「Info＃4」
"Company and Co"、 "Info＃5"

シート1には、使用されるすべての名前が含まれ（100前後ですが、上記のように異なる形式で）、シート2には、これらすべての100が複数の行に含まれ、さらに100リストにない名前が含まれているため、私はしません。気に。

最終結果が次のようなVBAコードプロジェクトを作成するにはどうすればよいですか、マスターシート：

「会社」、「情報＃1」、「情報＃2」、「情報＃3」、「情報＃4」、「情報＃5」

そこにあるすべての「会社」（100リスト）に対して??

私はこれに対する解決策があることを願っています。私はVBAプロジェクトにかなり慣れていませんが、以前に最小限のコーディングを行ったことがあります。

stringexcelvbamergematch
3
Ampi Severe

マクロをPERSONALセクションに配置します。これにより、すべてのワークシートでマクロを使用できるようになります。これを行うには、ダミーマクロを記録し、それをパーソナルマクロブックに保存することを選択します。これで、この個人用ワークブックに新しいマクロと関数を手動で追加できます。

私はこれを試しましたが（元のソースはわかりません）、正常に動作します。

式は次のようになります。= PERSONAL.XLSB！FuzzyFind（A1、B $ 1：B $ 20）

コードはここにあります：

Function FuzzyFind(lookup_value As String, tbl_array As Range) As String
Dim i As Integer, str As String, Value As String
Dim a As Integer, b As Integer, cell As Variant
For Each cell In tbl_array
  str = cell
  For i = 1 To Len(lookup_value)
    If InStr(cell, Mid(lookup_value, i, 1)) > 0 Then
      a = a + 1
      cell = Mid(cell, 1, InStr(cell, Mid(lookup_value, i, 1)) - 1) & Mid(cell, InStr(cell, Mid(lookup_value, i, 1)) + 1, 9999)
    End If
  Next i
  a = a - Len(cell)
  If a > b Then
    b = a
    Value = str
  End If
  a = 0
Next cell
FuzzyFind = Value
End Function
4
Robert Ilbrink

私はRobertソリューションを使用しましたが、それは私にとっては問題なく機能します。私はExcelを初めて使用するが、コーディングを知っている人々のためにソリューション全体を投稿しています。

このスレッドは古いですが、私は別のスレッドからいくつかのコードを取得して試しましたが、解決策はほぼ一致しているようです。ここでは、sheet1の1列をsheet2の1列と一致させようとしています。

  1. excelにコマンドボタンを追加
  2. 次のコードを入力し、ボタンと関数をクリック/実行すると、選択した列に結果が表示されます
 Private Sub CommandButton21_Click()
     Dim ws As Worksheet
     Dim LRow As Long, i As Long, lval As String


   '~~> Change this to the relevant worsheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

With ws
    '~~> Find Last Row in Col G which has data
    LRow = .Range("D" & .Rows.Count).End(xlUp).Row

    If LRow = 1 Then
        MsgBox "No data in column D"
    Else
        For i = 2 To LRow


             lval = "D"
            .Range("G" & i).Value = FuzzyFind(lval & i, .Range("PWC"))
        Next i
    End If
    End With

    End Sub


    Function FuzzyFind(lookup_value As String, tbl_array As Range) As String
    Dim i As Integer, str As String, Value As String
    Dim a As Integer, b As Integer, cell As Variant

    For Each cell In tbl_array
     str = cell
     For i = 1 To Len(lookup_value)
      If InStr(cell, Mid(lookup_value, i, 1)) > 0 Then
     a = a + 1
     cell = Mid(cell, 1, InStr(cell, Mid(lookup_value, i, 1)) - 1) & Mid   (cell, InStr(cell, Mid(lookup_value, i, 1)) + 1, 9999)
    End If
     Next i
     a = a - Len(cell)
     If a > b Then
       b = a
       Value = str
    End If
       a = 0
    Next cell
      If Value <> "" Then
         FuzzyFind = Value
      Else
         FuzzyFind = "None"
      End If
End Function
3
Garima SP

Google ExcelUDFファジールックアップまたはレーベンシュタイン距離を使用できます。いくつかのUDFが浮かんでいて、Microsoftにはファジールックアップ/マッチアドオンもあります（私がそれを使用したとき、それはクラッシュしやすく、直感的ではありませんでした）。

2
Robert Ilbrink

正確には正確ではありませんが類似しており、myの問題を扱っている人はthis検索時のページ。

タスク：住所を含む、自動車事故にあった患者のリスト。同じ住所に基づいて関連するアカウントを検索します。リストは最大でおそらく120レコードになりますpartial手動レビューは現実的です。

問題：番地は類似していますが同一ではありません。例： 123 JONESLANEおよび123JONES LN、または72 MAIN STREET＃32および72 MAIN STREET＃32。

Partの解決策は、番地のみを比較することです。そのサイズのリストでは、同じ番地を持つ2つの異なる住所（たとえば、123 JONESLANEと123MAIN STREET）があるのは珍しいことです。

注意： VAL（）を使用して番地を取得することはできません。 167 E 13STでお試しください。 VBAはそれを167 ^ 13と見なし、Street_Num AsIntegerに出力するとクラッシュします。したがって、ループを使用して数字を新しい文字列にプルし、最初の数字以外の文字で停止する必要があります。

0
RIck_R

このDDoE投稿 の関数を見てください。最長共通シーケンス文字列を生成し、その長さを元の文字列と比較できます。いくつかの既知の一致といくつかの近い不一致をフィードし、それらの間に明確な境界線が表示されるかどうかを確認します。

これらの関数は、差分をとるために使用され、近い一致を見つけることはありませんが、機能する場合があります。

0
Dick Kusleika