按关键字眼条件提取数据

lg747699

数据量很大，请帮忙设计VBA代码提取。

CC例例

1. Sub Test()
   
2.     Dim Arr, Brr, i&, x&
   
3.     Arr = [a1].CurrentRegion
   
4.     [g1].CurrentRegion.Offset(1).ClearContents
   
5.     ReDim Brr(1 To UBound(Arr), 1 To 5)
   
6.     For i = 3 To UBound(Arr)
   
7.         If InStr(Arr(i, 3), "酸洗") Then
   
8.             x = x + 1
   
9.             Brr(x, 1) = Right(Arr(1, 3), 12)
   
10.             Brr(x, 2) = Arr(1, 2)
    
11.             Brr(x, 3) = Arr(i, 3)
    
12.             Brr(x, 4) = Arr(i, 2)
    
13.             Brr(x, 5) = Arr(i, 5)
    
14.         End If
    
15.     Next
    
16.     [g2].Resize(UBound(Brr), 5) = Brr
    
17. End Sub

复制代码

lg747699

CC例例 发表于 2016-9-24 14:36

不可以，请放入附件测试，谢谢。

CC例例

咋不可以？我已测试过。

lg747699

我里面有那么多行数据，只取出那10行数据，有遗漏。

CC例例

这可能是你表格与上传的表格数据结构不同造成的，重新上传个数据结构一样的附件。

lg747699

附件的格式就是标准的了，不能再修改。
Arr = [a1].CurrentRegion
这一句选择区域可能出问题，因为我数据中间有空行。

CC例例

那你自己改一下吧。

lg747699

CC例例 发表于 2016-9-24 16:28
那你自己改一下吧。

改了也不对

CC例例

水平有限，无能为力！