按关键字眼条件提取数据

lg747699

CC例例 发表于 2016-9-24 17:09
水平有限，无能为力！

不要这样说，谢谢你的帮助。

lsc900707

不计重复的话，应该有一千多项吧

lg747699

lsc900707 发表于 2016-9-24 17:36
不计重复的话，应该有一千多项吧

压缩机全部是ASM103N11UFZ，实际上还有其他机型，例如ASK49E1UZR等，麻烦再修改，谢谢。

lsc900707

lg747699 发表于 2016-9-24 22:18
压缩机全部是ASM103N11UFZ，实际上还有其他机型，例如ASK49E1UZR等，麻烦再修改，谢谢。

喔，这倒没注意到，明天再看看吧。>>>>>>>>>>

小花鹿

用两层循环，外层判断项目编码和压缩机，内层判断关键字，遇到空行退出循环..............................

lg747699

小花鹿 发表于 2016-9-25 10:31
用两层循环，外层判断项目编码和压缩机，内层判断关键字，遇到空行退出循环..............................

请帮忙，谢谢

lg747699

未解决，跪求帮助。

lg747699

未解决，跪求帮助。

lg747699

未解决，空行提取。

yangyangzhifeng

试试看

1. Sub test()
   
2.     Dim arr, brr(), i&, n&, m&, t$
   
3.     arr = Sheet1.Range("A1", Sheet1.Range("E" & Rows.Count).End(xlUp))
   
4.     ReDim brr(1 To UBound(arr), 1 To 5)
   
5.     For i = 1 To UBound(arr)
   
6.         If arr(i, 1) Like "项目编码*" Then
   
7.             n = i
   
8.             t = Split(arr(i, 3), " ")(UBound(Split(arr(i, 3), " ")))
   
9.         ElseIf arr(i, 3) Like "*酸洗*" Then
   
10.             m = m + 1
    
11.             brr(m, 1) = t
    
12.             brr(m, 2) = arr(n, 2)
    
13.             brr(m, 3) = arr(i, 3)
    
14.             brr(m, 4) = arr(i, 2)
    
15.             brr(m, 5) = arr(i, 5)
    
16.         End If
    
17.     Next
    
18.     Application.ScreenUpdating = False
    
19.     Sheet1.Range("G2", Sheet1.Range("k" & Rows.Count)).ClearContents
    
20.     Sheet1.Range("G2").Resize(m, UBound(brr, 2)) = brr
    
21.     Application.ScreenUpdating = True
    
22. End Sub
    

复制代码