提取含有关键字的单元格 为什么不对

cql465505

Book1.rar (12.97 KB, 下载次数: 9)

2019-2-20 10:02 上传

点击文件名下载附件

liulang0808

1. Sub gj23w98()
   
2. 
   
3.     Dim i, j, arr, d
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     arr = [g10:g15]
   
6.     brr = Range("a1:c" & [c65536].End(3).Row)
   
7.     For j = 1 To UBound(arr)
   
8.         For i = 1 To UBound(brr)
   
9.         If InStr(brr(i, 3), arr(j, 1)) Then
   
10.             d(arr(j, 1)) = d(arr(j, 1)) & brr(i, 1) & "," & brr(i, 2) & ","
    
11.         End If
    
12.     Next i, j
    
13.     k = 11
    
14.     For Each sj In d
    
15.         i = 2
    
16.         For j = 0 To UBound(Split(d(sj), ",")) - 1 Step 2
    
17.             Cells(i, k) = Split(d(sj), ",")(j)
    
18.             Cells(i, k + 1) = Split(d(sj), ",")(j + 1)
    
19.             i = i + 1
    
20.         Next j
    
21.         k = k + 2
    
22.     Next
    
23. End Sub
    

复制代码

碣石山人

学习了！另外，楼主的数据有些问题，有些为.1有些为..1这样会造成数据不准确

cql465505

谢谢 非常感谢 有些为.1有些为..1可能是数据传输的问题 程序可以考虑处理吗？

liulang0808

cql465505 发表于 2019-2-20 15:03
谢谢 非常感谢 有些为.1有些为..1可能是数据传输的问题 程序可以考虑处理吗？

2楼的处理还有什么问题吗

cql465505

liulang0808 发表于 2019-2-20 15:10
2楼的处理还有什么问题吗

与正确结果不一样

liulang0808

楼主的正确答案能结合附件说明下吗
截图是查找的对应关系的

cql465505

是我不对 非常感谢 谢谢