在Excel VBA項目中匹配類似但不精確的文本字符串

好的，我一直在試圖找到一個解決方案，我似乎不能。我甚至無法正確分解問題。這是主意。在Excel VBA項目中匹配類似但不精確的文本字符串

我有兩個很多行的表（一個800和另一個300,000）。每行包含一個名稱列，然後包含多個包含有關此名稱信息的列。每張紙都有不同種類的信息。

我想將這兩張表合併到基於這兩個名稱列的母表中，因此鞏固函數對此非常合適。現在的問題是名稱並不完美。

例如Sheet 1中包含

「公司BV」，「信息＃1」
「公司總計」，「信息＃2」
「有限公司」，「信息＃3」

和片2包含

「公司和Co.」，「信息＃4」
「公司和Co」，「信息＃5」

表1，包含3 ns將要使用的所有名稱（大約100，但是採用上述不同的形式），並且工作表2包含多行中的所有這100個以及不在100列表中的名稱，因此我不在意。

我怎麼會做出VBA代碼項目中，最終的結果會是這樣，原材：

「公司」，「信息＃1」，「信息＃2」，「信息＃3」，「Info＃4」，「Info＃5」

對於每一個「公司」（100名單）在那裏？

我希望有一個解決方案。我對VBA項目相當陌生，但之前我已經完成了一些最小編碼。

來源

2012-11-08 Ampi Severe

你需要決定哪些規則使「公司BV」與「公司和公司」相同然後應用它們進行轉換。例如。它總是第一個字嗎？或者在更換一組單詞（b.v./total/and co。）後留下了什麼？ ...如果你不能說清楚這一點，你將無法做到這一點。 –

你有什麼「非常相似」設置**某種**的標準是指...例如，這將是確定，只是匹配基於2片之間的第一個字？ –

是的，你是正確的，不幸的是，第一個字不是一個選項。是否有可能找到兩個字符串之間匹配的最小字符長度，並將其用作「公司」名稱，即整個單詞應完美匹配，包括前後的空格。 –

我會把宏放在你的PERSONAL部分，這樣宏在所有工作表中都可用。通過錄制虛擬宏並選擇將其存儲在個人宏工作簿中來完成此操作。現在你可以在這個個人工作簿中手動添加新的宏和函數。

我剛試過這一個（不知道原始來源），它工作正常。

公式如下所示：= PERSONAL.XLSB！FuzzyFind（A1，B $ 1：乙$ 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

來源

2012-11-12 18:46:52

非常感謝您的代碼！如果找不到大於（例如）4個字符或以上的匹配，可以不返回任何內容（空白單元格）嗎？ –

查看this DDoE post上的功能。您可以生成最長的公共序列字符串，並將長度與原始字符串進行比較。給它一些已知的匹配和一些非匹配的非匹配，看看你是否可以在它們之間看到明確的分界線。

這些函數用於比較，沒有找到近似匹配，但它們可能適用於您。

來源

2012-11-08 22:24:08

這些功能看起來對我的問題非常有用。如果我想要匹配兩個不同的字符串，我會首先使用LCSTable並將該表用作LCSString函數的輸入。 –

你可以谷歌Excel UDF模糊查找或Levensthein距離。有一些UDF在浮動，微軟也有一個模糊的查找/匹配附加組件（當我使用它時，它很容易崩潰並且不直觀）。

來源

2012-11-09 06:25:45

這看起來很像我需要什麼，但我得到一個編譯錯誤（「變量沒有定義」），酷似INT這篇文章：http://www.mrexcel.com/forum/excel-questions/64987-comparing-two -columns.html –

我用羅伯特解決方案，它爲我工作得很好。我張貼的人誰對Excel是新的整體解決方案，但都知道編碼：

雖然這個線程是舊的，但我花了一些代碼從另一個線程和嘗試，看起來像解決方案是給約相匹配。在這裏，我想sheet1中的一列與Sheet2中的一列匹配：

在Excel中添加命令按鈕
放下面的代碼，然後點擊/運行按鈕和功能給你造成所選列

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

來源

2015-11-24 12:39:12

在Excel VBA項目中匹配類似但不精確的文本字符串

回答

相關問題