我想这个VBA解决方案可以工作，但肯定不是100%可靠：

Sub matchWords()
    Dim arr() As Variant, rng As Range
    Set rng = Range("data")
    arr = rng
    
    
    Dim val1 As String, val2 As String
    For i = LBound(arr) To UBound(arr)
        arr(i, 3) = ""
        For j = LBound(arr) To UBound(arr)
            val1 = LCase(arr(i, 2))
            val2 = LCase(Left(Replace(arr(j, 1), " ", ""), Int(Len(Replace(arr(j, 1), " ", "")) * 0.7)))
            If InStr(1, val1, val2) <> 0 Then
                arr(i, 3) = arr(j, 1) & "?" & arr(i, 3)
            End If
        Next j
        arr(i, 3) = Left(arr(i, 3), Len(arr(i, 3)) - 1)
    Next i
    rng = arr
End Sub

在这个名为“data”的表上测试。有时，有多个匹配，在这种情况下，两个都放入第三列，用问号分隔：
| cat1|cat2|matchedCat1|
| - ------|- ------|- ------|
| anesthesiologist|professional. Accountants|accounting|
| appliances|nightlife.adultentertainment|adult entertainment|
| aircraft dealer|professional.advertising|x1米11米1x|
| airline|industry.agriculture|agriculture|
| animal shelter|auto.aircraftdealers|aircraft dealer|
| apartments|hotelstravel.transport.airlines|x1米20英寸1x|
| airport|hotelstravel.airports|airport|
| alternative medicine|hotelstravel.airports.airportterminals|airport terminal?airport|
| amusement park|health.physicians.allergist|allergist|
| x1米30英寸1x|health.alternativemedicine|alternative medicine|
| allergist|active.amusementparks|amusement park|
| accounting|health.physicians.anesthesiologists|anesthesiologist|
| x1米39英寸|x1米40英寸1x|animal shelter|
| agriculture|realestate.apartments|apartments|
| adult entertainment|shopping.homeandgarden.appliances|appliances|

• 以防任何主持人遇到以下情况：这个表看起来像这样的原因是因为SO不允许我在没有将每个条目格式化为代码的情况下发布它。这个“特性”非常需要修复或完全取消。