查找单元格中内容匹配某些关键字，并在后面返回关键字对应标签

ksharpbury

因保密限制，附件内容为我自己编写，想实现功能为：1、在待分析工单页，先用优先分类规则里的关键字，到待分析工单页的D列“标签”去匹配，如果匹配到了，在待分析工单的H列和I列，返回优先分类规则页匹配到的那个关键字后面的一类分类和二类分类。
2、对于没有匹配到的待分析工单，用普通分类规则里的关键字到待分析的工单整行里去匹配，如果匹配到了，也是在H列和I列返回普通分类规则那行的对应一级和二级分类。

主要困扰：优先分类规则还好，普通分类规则里的关键字非常杂乱，且有“OR”和“+”代表或和并，普通分类规则中的红字为实际需求，我只节选了一部分，不知是否必须需要对关键字进行整理，如果需要，应该按照什么思路去整理？请大神指教。

示例.rar (9.45 KB, 下载次数: 90)

2018-3-21 14:50 上传

点击文件名下载附件

fyure

感觉不是很好用，你稍微变动一个字，不就匹配失败了吗？比如自助+转账+撤销,万一写的是取消/失败呢，
自助设备+（错账or吞钞）万一写的是ATM呢，需要大量罗列覆盖。

ksharpbury

fyure 发表于 2018-3-21 15:15
感觉不是很好用，你稍微变动一个字，不就匹配失败了吗？比如自助+转账+撤销,万一写的是取消/失败呢，
自助 ...

是的，还有就是关键字的顺序不固定，只要能全匹配上就返回。像您说的那种情况，客户需求说只要匹配不到就不返回，最后剩下的应该也不多，就人工处理了。

Chip_Kenny

示例上模擬結果來及將关键字紅色, 好等測試。

ksharpbury

真心求助，任务做不下去了，请给点思路也行。

fyure

ksharpbury 发表于 2018-3-21 15:22
是的，还有就是关键字的顺序不固定，只要能全匹配上就返回。像您说的那种情况，客户需求说只要匹配不到就 ...

要不这样，先把+（）OR这些非汉字的字符全替换成统一符号比如逗号，然后用split割成数组，用数组元素去逐个匹配。
比如自助设备+（错账or吞钞）转成arr（自助设备，错账，吞炒），拿这3个词去描述里遍历，比如说遍历到2个，就算过了，换下一条描述。要是没匹配到就换下一个关键词数组

ksharpbury

fyure 发表于 2018-3-22 09:16
要不这样，先把+（）OR这些非汉字的字符全替换成统一符号比如逗号，然后用split割成数组，用数组元素去逐 ...

这样的话，您举例这种遍历到2个就算过，如果都是+的话就需要全部匹配到，对每个数组设定规则还不一样。并且，假设说举例这个遍历到后2个是不应该算匹配的。

fyure

ksharpbury 发表于 2018-3-22 09:32
这样的话，您举例这种遍历到2个就算过，如果都是+的话就需要全部匹配到，对每个数组设定规则还不一样。并 ...

不是啊，我的理解是你昨天自己也承认了，输入数据是有可能和定好的关键词有细微差别的的，也就是不可控的。用具体的某几个词去匹配不可控输入，本来精度就会有问题。。。
若是说+就必须匹配到，（转账+撤销）时（转账+撤消）就匹配不到，但能说不是一个意思吗？此外还有OR的情况存在，因此才建议允许个别匹配不到。
【客户需求说只要匹配不到就不返回，剩下手工处理】从这话看，需求的就是一个近似结果。
一下子拿不出完美方案的话，还是建议拿实际数据逐步试试，看看结果是不是在合理范围内。
帮你顶顶，希望有大神给出好的方法

ksharpbury

谢谢你，手工顶一顶

Chip_Kenny

try this:

1. Sub zz()
   
2. Dim a, b(), ar, s$, ss$, k, t
   
3. With Sheets(2)
   
4.     a = .Range("a2:c" & .[a1048576].End(3).Row).Value
   
5. End With
   
6. With Sheets(1)
   
7.     ar = .Range("d2:g" & .[d1048576].End(3).Row).Value
   
8. End With
   
9. ReDim b(1 To UBound(ar), 1 To 3)
   
10. For i = 1 To UBound(ar)
    
11.     For j = 1 To UBound(ar, 2)
    
12.         b(i, 3) = b(i, 3) & ar(i, j)
    
13.     Next
    
14.     For j = 1 To UBound(a)
    
15.         If InStr(ar(i, 1), a(j, 1)) Then
    
16.             b(i, 1) = a(j, 2): b(i, 2) = a(j, 3)
    
17.             Exit For
    
18.         End If
    
19.     Next
    
20. Next
    
21. With Sheets(3)
    
22.     a = .Range("a2:c" & .[c1048576].End(3).Row).Value
    
23. End With
    
24. ReDim ar(1 To UBound(a), 1 To 2)
    
25. For i = 1 To UBound(a)
    
26.     s = Replace(Replace(LCase(a(i, 1)), "(", ""), ")", "")
    
27.     k = Split(s, "+")
    
28.     ss = "": s = ""
    
29.     For j = 0 To UBound(k)
    
30.         If InStr(k(j), "or") = 0 Then
    
31.             s = s & "|" & k(j)
    
32.         Else
    
33.             t = Split(k(j), "or")
    
34.             For jj = 0 To UBound(t)
    
35.                 ss = ss & "|" & t(jj)
    
36.             Next
    
37.         End If
    
38.     Next
    
39.     ar(i, 1) = Split(Mid(s, 2), "|")
    
40.     ar(i, 2) = Split(Mid(ss, 2), "|")
    
41. Next
    
42. For i = 1 To UBound(b)
    
43.     If Len(b(i, 1)) = 0 Then
    
44.         For ii = 1 To UBound(ar)
    
45.             k = ar(ii, 1): t = ar(ii, 2): n = 0
    
46.             For j = 0 To UBound(k)
    
47.                 If InStr(b(i, 3), k(j)) Then n = n + 1
    
48.             Next
    
49.             If n - 1 <> UBound(k) Then Exit For
    
50.             n = 0
    
51.             For j = 0 To UBound(t)
    
52.                 If InStr(b(i, 3), t(j)) Then n = 1: Exit For
    
53.             Next
    
54.             If n Or UBound(t) = -1 Then
    
55.                 b(i, 1) = a(ii, 2): b(i, 2) = a(ii, 3): Exit For
    
56.             End If
    
57.         Next
    
58.     End If
    
59. Next
    
60. [h2].Resize(UBound(b), 2) = b
    
61. End Sub

复制代码