[已解决]原一个条件件查找想改两个条件查找

huangxuejin

原一个条件查找想增加一个条件查找，求助哪位老师帮帮我改一下VBA代码，原代码也是从该网站下载的，本人VBA白痴不懂得改在此先谢谢您了。

最佳答案

月排行榜 / 总排行榜

dsmch

2016-11-20 09:15

1. Sub Macro1()
   
2. Dim arr, brr, i&, j%
   
3. ReDim brr(1 To 10000, 1 To 10)
   
4. Sheets("查询").Activate
   
5. mc = [b3]: gg = [b4] '名称、规格
   
6. [c3:l2000] = ""
   
7. For Each sh In Sheets
   
8.     If sh.Name <> ActiveSheet.Name Then
   
9.         arr = sh.Range("b3").CurrentRegion
   
10.         For i = 2 To UBound(arr)
    
11.             If arr(i, 3) Like "*" & mc & "*" And arr(i, 4) = gg Then
    
12.                 s = s + 1
    
13.                 For j = 1 To UBound(arr, 2)
    
14.                     brr(s, j) = arr(i, j)
    
15.                 Next
    
16.             End If
    
17.         Next
    
18.     End If
    
19. Next
    
20. If s Then Range("c3").Resize(s, 10) = brr
    
21. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, i&, j%
   
3. ReDim brr(1 To 10000, 1 To 10)
   
4. Sheets("查询").Activate
   
5. mc = [b3]: gg = [b4] '名称、规格
   
6. [c3:l2000] = ""
   
7. For Each sh In Sheets
   
8.     If sh.Name <> ActiveSheet.Name Then
   
9.         arr = sh.Range("b3").CurrentRegion
   
10.         For i = 2 To UBound(arr)
    
11.             If arr(i, 3) Like "*" & mc & "*" And arr(i, 4) = gg Then
    
12.                 s = s + 1
    
13.                 For j = 1 To UBound(arr, 2)
    
14.                     brr(s, j) = arr(i, j)
    
15.                 Next
    
16.             End If
    
17.         Next
    
18.     End If
    
19. Next
    
20. If s Then Range("c3").Resize(s, 10) = brr
    
21. End Sub

复制代码

huangxuejin

dsmch 发表于 2016-11-20 09:15

感谢您的帮助，如果我表格不止10列比如后面增加3列有13列，代码能帮我改一下吗，

huangxuejin

dsmch 发表于 2016-11-20 09:15

我明白了这两句改： ReDim brr(1 To 10000, 1 To 15)
                                If s Then Range("c3").Resize(s, 15) = brr

再次感谢您在百忙之中帮助了我，谢谢...谢谢......