[已解决]跪!按模糊查找显示对应序号

france723

如图所示, A列的序号对应C列的条件.比如按模糊查找 "[F1,F3]" ,就能找到对应的 I1,I2,I3,I4,I9,I10
*代表任意 F几,  G1代表F1,F2,F3中的任意一个查询时只以F查询, ALL代表全部 (I目前有10个, 当它变化数量,程序一样使用)

找到后显示到第四个工作表“Feuil4”里，与之对应。
（我自己写的是每个每个转换对应的都是所有的I，希望大神修改)
跪求大神帮忙

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-3-25 13:21

1. Private Sub CommandButton1_Click()
   
2. Dim s, s1$, arr, brr, d As Object, i&, j&, c
   
3. Set d = CreateObject("scripting.dictionary")
   
4. s = Split([e8], ",")
   
5. arr = [a1].CurrentRegion
   
6. For i = 1 To UBound(arr)
   
7.   If arr(i, 3) = "ALL" Then
   
8.     d(arr(i, 3)) = d(arr(i, 3)) & "," & arr(i, 1)
   
9.   Else
   
10.     brr = Split(arr(i, 3), "]")
    
11.     For j = 0 To UBound(brr)
    
12.       If j = 0 Then brr(j) = Mid(brr(j), 2) Else brr(j) = Mid(brr(j), 3)
    
13.       d(brr(j)) = d(brr(j)) & "," & arr(i, 1)
    
14.     Next j
    
15.   End If
    
16. Next i
    
17. d.Remove ""
    
18. For Each c In d.keys
    
19.   If c = "ALL" Then
    
20.     s1 = s1 & "," & Mid(d(c), 2)
    
21.   Else
    
22.     brr = Split(c, ",")
    
23.     If brr(0) = "*" Then
    
24.       brr(0) = s(0)
    
25.     Else
    
26.       If brr(0) = "G1" Then If s(0) = "F1" Or s(0) = "F2" Or s(0) = "F3" Then brr(0) = s(0)
    
27.     End If
    
28.     If brr(1) = "*" Then
    
29.       brr(1) = s(1)
    
30.     Else
    
31.       If brr(1) = "G1" Then If s(1) = "F1" Or s(1) = "F2" Or s(1) = "F3" Then brr(1) = s(1)
    
32.     End If
    
33.     If Join(brr) = Join(s) Then s1 = s1 & "," & Mid(d(c), 2)
    
34.   End If
    
35. Next c
    
36. [f8] = Mid(s1, 2)
    
37. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

ipad不方便写代码测试，提供下我的思路：
1、将所有数据装入二维数组；
2、顺序装入字典，key为方括号内容，item为A列序号，并连接成字符串；
3、顺序装入字典前，顺便将通配部分转换成可查询信息；
4、查询结果由字典给出
也可以将通配部分的转换放在查询时做，比较灵活

大灰狼1976

1. Private Sub CommandButton1_Click()
   
2. Dim s, s1$, arr, brr, d As Object, i&, j&, c
   
3. Set d = CreateObject("scripting.dictionary")
   
4. s = Split([e8], ",")
   
5. arr = [a1].CurrentRegion
   
6. For i = 1 To UBound(arr)
   
7.   If arr(i, 3) = "ALL" Then
   
8.     d(arr(i, 3)) = d(arr(i, 3)) & "," & arr(i, 1)
   
9.   Else
   
10.     brr = Split(arr(i, 3), "]")
    
11.     For j = 0 To UBound(brr)
    
12.       If j = 0 Then brr(j) = Mid(brr(j), 2) Else brr(j) = Mid(brr(j), 3)
    
13.       d(brr(j)) = d(brr(j)) & "," & arr(i, 1)
    
14.     Next j
    
15.   End If
    
16. Next i
    
17. d.Remove ""
    
18. For Each c In d.keys
    
19.   If c = "ALL" Then
    
20.     s1 = s1 & "," & Mid(d(c), 2)
    
21.   Else
    
22.     brr = Split(c, ",")
    
23.     If brr(0) = "*" Then
    
24.       brr(0) = s(0)
    
25.     Else
    
26.       If brr(0) = "G1" Then If s(0) = "F1" Or s(0) = "F2" Or s(0) = "F3" Then brr(0) = s(0)
    
27.     End If
    
28.     If brr(1) = "*" Then
    
29.       brr(1) = s(1)
    
30.     Else
    
31.       If brr(1) = "G1" Then If s(1) = "F1" Or s(1) = "F2" Or s(1) = "F3" Then brr(1) = s(1)
    
32.     End If
    
33.     If Join(brr) = Join(s) Then s1 = s1 & "," & Mid(d(c), 2)
    
34.   End If
    
35. Next c
    
36. [f8] = Mid(s1, 2)
    
37. End Sub

复制代码

france723

大灰狼1976 发表于 2017-3-25 13:21

谢谢大神！