任意（单个或多个)条件的模糊查询求教！

chengshanming

我想把ar(i, 1) Like "*" & cells(i,1) & "*"   and  ar(i, 2) Like "*" & cells(i,2) & "*" and  ar(i, 3) Like "*" & cells(i,3) & "*" ……and ar(i, J) Like "*" & cells(i,J) & "*" ，有没有一种简要的表达方式？

一把小刀闯天下

'可以是全部条件，你这7个条件当然也是可以用的

Option Explicit

Sub zz()
  Dim j, i, arr, brr, n, first, last, cond
  With Sheets("数据来源")
    arr = .Range("a2:r" & .Cells(Rows.Count, "a").End(xlUp).Row)
  End With
  ReDim brr(1 To UBound(arr, 1), 1 To UBound(arr, 2))
  With Sheets("查询")
    first = .[c1]: last = .[c2]: cond = .[a4:r4]
    For i = 1 To UBound(arr, 1)
      If arr(i, 1) <= last And arr(i, 1) >= first Then
        For j = 1 To UBound(cond, 2)
          If Len(cond(1, j)) > 0 Then
            If InStr(arr(i, j), cond(1, j)) = 0 Then Exit For
          End If
        Next
        If j = UBound(cond, 2) + 1 Then
          n = n + 1
          For j = 1 To UBound(cond, 2): brr(n, j) = arr(i, j): Next
        End If
      End If
    Next
    .[a6].Resize(.Cells(Rows.Count, "a").End(xlUp).Row, UBound(brr, 2)).ClearContents
    If n > 0 Then .[a6].Resize(n, UBound(brr, 2)) = brr
  End With
End Sub

chengshanming

一把小刀闯天下 发表于 2018-3-20 17:27
'可以是全部条件，你这7个条件当然也是可以用的
已OK!是帖子审核速度太慢，没看到以为回复没成功，所以重复回复了！
Option Explicit

1. Sub zz()
   
2.   Dim j, i, arr, brr, n, first, last, cond
   
3.   Dim sh As Worksheet
   
4.   [a6].Resize(Cells(Rows.Count, "a").End(xlUp).Row, UBound(UsedRange.Value, 2)).ClearContents
   
5.   For Each sh In ThisWorkbook.Sheets
   
6.   With sh
   
7.     arr = .Range("a2:r" & .Cells(Rows.Count, "a").End(xlUp).Row)
   
8.   End With
   
9.   ReDim brr(1 To UBound(arr, 1), 1 To UBound(arr, 2))
   
10.   With Sheets("查询")
    
11.     first = .[c1]: last = .[c2]: cond = .[a4:r4]
    
12.     For i = 1 To UBound(arr, 1)
    
13.       If arr(i, 1) <= last And arr(i, 1) >= first Then
    
14.         For j = 1 To UBound(cond, 2)
    
15.           If Len(cond(1, j)) > 0 Then
    
16.             If InStr(arr(i, j), cond(1, j)) = 0 Then Exit For
    
17.           End If
    
18.         Next
    
19.         If j = UBound(cond, 2) + 1 Then
    
20.           n = n + 1
    
21.           For j = 1 To UBound(cond, 2): brr(n, j) = arr(i, j): Next
    
22.         End If
    
23.       End If
    
24.     Next
    
25.     If n > 0 Then .Range("a" & UsedRange.Rows.Count + 1).Resize(n, UBound(brr, 2)) = brr
    
26.   End With
    
27.   Next
    
28. End Sub
    

复制代码

chengshanming

一把小刀闯天下 发表于 2018-3-20 17:27
'可以是全部条件，你这7个条件当然也是可以用的

Option Explicit

小刀闯天下大师好！你的这中方法的代码可以应用于一个工作薄多张格式相同的工作表的这中情况吗？我试了一下，好像只能取到一张表的明细。

1. Sub zz()
   
2.   Dim j, i, arr, brr, n, first, last, cond
   
3.   Dim sh As Worksheet
   
4.   [a6].Resize(Cells(Rows.Count, "a").End(xlUp).Row, UBound(UsedRange.Value, 2)).ClearContents
   
5.   For Each sh In ThisWorkbook.Sheets
   
6.   With sh
   
7.     arr = .Range("a2:r" & .Cells(Rows.Count, "a").End(xlUp).Row)
   
8.   End With
   
9.   ReDim brr(1 To UBound(arr, 1), 1 To UBound(arr, 2))
   
10.   With Sheets("查询")
    
11.     first = .[c1]: last = .[c2]: cond = .[a4:r4]
    
12.     For i = 1 To UBound(arr, 1)
    
13.       If arr(i, 1) <= last And arr(i, 1) >= first Then
    
14.         For j = 1 To UBound(cond, 2)
    
15.           If Len(cond(1, j)) > 0 Then
    
16.             If InStr(arr(i, j), cond(1, j)) = 0 Then Exit For
    
17.           End If
    
18.         Next
    
19.         If j = UBound(cond, 2) + 1 Then
    
20.           n = n + 1
    
21.           For j = 1 To UBound(cond, 2): brr(n, j) = arr(i, j): Next
    
22.         End If
    
23.       End If
    
24.     Next
    
25.     If n > 0 Then .Range("a" & UsedRange.Rows.Count + 1).Resize(n, UBound(brr, 2)) = brr
    
26.   End With
    
27.   Next
    
28. End Sub
    

复制代码

小刀闯天下大师好！你的这中方法的代码可以应用于一个工作薄多张格式相同的工作表的这中情况吗？我试了一下，好像只能取到一张表的明细。