模糊搜寻字串返回特定文字

Groove

各位老师大家好, 想要VBA Find或者其他代码编写, 大神们可以帮我写一个吗?
以上内容是读取由A2的内容与G列中的清单比较. 如中条件就返回H列中的值
如A2中出现 中文 与G列的中文相对应, 而返回chinese
如A4中 出现物理 数学 只需要第一个条件中就返回 G列的物理, 返回physical
因为数据越来越多, 运行公式太慢

liulang0808

1. Sub °′Å￥1_Click()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Application.ScreenUpdating = False
   
4.     arr = [a1].CurrentRegion
   
5.     brr = [g1].CurrentRegion
   
6.     For j = 2 To UBound(brr)
   
7.         d(brr(j, 1)) = brr(j, 2)
   
8.     Next j
   
9.     For j = 2 To UBound(arr)
   
10.         crr = Split(arr(j, 1), " ")
    
11.         For i = 0 To UBound(crr)
    
12.             If d.exists(crr(i)) Then Cells(j, 3) = d(crr(i)): Exit For
    
13.         Next i
    
14.     Next j
    
15.     Application.ScreenUpdating = True
    
16. End Sub
    

复制代码

liulang0808

附件内容供参考。。。。。