巧用VBA實現：基於多個關鍵詞模糊匹配Excel多行數據

　　在用Excel處理實際業務中，我們會碰到如下場景：

　　1、從一堆人名中找到包含某些關鍵字的名字；

　　2、從銀行流水文件中根據【備註】字段找到包含某些關鍵字的，統一識別爲【手續費業務】等。

　　這本質說的都是一類問題：如何從數據集中，根據業務需求配置的多個關鍵字，匹配得到對應的行項目。這個問題有好的辦法嗎？

　　如果我們使用Excel自帶的【自定義自動篩選】功能，它只能支持添加最多兩組關鍵字，無法添加更多，如下圖所示：

　　如果我們有多個關鍵詞供我們作爲篩選條件，Excel自帶的【自定義自動篩選】功能自然不夠用。假設我們的工作簿總共有三張表，【基礎信息】、【姓名關鍵字】、【結果】表，結構如下：

 

 

 

 

 

 　　問題是，如何從【基礎信息】表中找到【姓名】列 符合【姓名關鍵字】表中的行項目，將對應行記錄在【結果】表中？

　　常規的Excel功能已經無法奏效，我們需要利用VBA手段來實現。具體思路：循環遍歷【基礎信息】表每一個姓名，循環取出【姓名關鍵字】表每個關鍵字，看取出的姓名是否包含這些【關鍵字】中的一個，如果是，就將【基礎信息】表這一行信息記錄在【結果】表中，這樣就達到了基於多個關鍵字中任意一個來過濾原始數據的效果。

　　VBA示例代碼如下：

Sub keyWordFilter()
Dim sht1 As Worksheet, sht2 As Worksheet, sht3 As Worksheet, maxRow1 As Integer, maxRow2 As Integer, maxRow3 As Integer, userName As String, i As Integer, j As Integer, keyWord As String, k As Integer

Set sht1 = ThisWorkbook.Sheets("基礎信息")
Set sht2 = ThisWorkbook.Sheets("姓名關鍵字")
Set sht3 = ThisWorkbook.Sheets("結果")

maxRow1 = sht1.Cells(Rows.Count, 1).End(xlUp).Row '基礎信息表 行數
maxRow2 = sht2.Cells(Rows.Count, 1).End(xlUp).Row '姓名關鍵字表 行數
maxRow3 = sht3.Cells(Rows.Count, 1).End(xlUp).Row '結果表 行數
sht3.Rows("2:" & maxRow3).ClearContents '清空【結果表】上次留存結果，保留擡頭行
k = 2
For i = 2 To maxRow1
    userName = sht1.Cells(i, 2).Value
    For j = 2 To maxRow2
        keyWord = sht2.Cells(j, 1).Value
        
        If userName Like "*" & keyWord & "*" Then '判斷某個姓名是否包含某個關鍵字
            sht3.Cells(k, 1).Value = sht1.Cells(i, 1).Value
            sht3.Cells(k, 2).Value = sht1.Cells(i, 2).Value
            sht3.Cells(k, 3).Value = sht1.Cells(i, 3).Value
            k = k + 1
            Exit For
        End If
    Next
Next

End Sub

最後代碼執行的效果，如下圖所示，非常方便：

 

 

歡迎掃碼關注我的公衆號 獲取更多爬蟲、數據分析的知識！