[已解决]求对比然后提取

sanfuhai

对比，判段是否包含的数字，然后提取，详情请看附件： 求对比提取的代码.rar (2.22 KB, 下载次数: 16)

2017-5-6 10:51 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-5-6 11:16

1. Sub aaa()
   
2. Dim arr, brr, crr, i&, j&, s$
   
3. arr = Range("c2:d" & [c65536].End(3).Row)
   
4. brr = [q2:q15]
   
5. For i = 1 To UBound(brr)
   
6.   If brr(i, 1) <> "" Then
   
7.     For j = 1 To UBound(arr)
   
8.       crr = Split(arr(j, 2), ",")
   
9.       If UBound(crr) <> UBound(Filter(crr, brr(i, 1), False)) Then s = s & "," & arr(j, 1)
   
10.     Next j
    
11.     brr(i, 1) = Mid(s, 2)
    
12.     s = ""
    
13.   End If
    
14. Next i
    
15. [u2].Resize(UBound(brr)) = brr
    
16. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

1. Sub aaa()
   
2. Dim arr, brr, crr, i&, j&, s$
   
3. arr = Range("c2:d" & [c65536].End(3).Row)
   
4. brr = [q2:q15]
   
5. For i = 1 To UBound(brr)
   
6.   If brr(i, 1) <> "" Then
   
7.     For j = 1 To UBound(arr)
   
8.       crr = Split(arr(j, 2), ",")
   
9.       If UBound(crr) <> UBound(Filter(crr, brr(i, 1), False)) Then s = s & "," & arr(j, 1)
   
10.     Next j
    
11.     brr(i, 1) = Mid(s, 2)
    
12.     s = ""
    
13.   End If
    
14. Next i
    
15. [u2].Resize(UBound(brr)) = brr
    
16. End Sub

复制代码