模糊查询

SCWYZJ

谢谢vitrel师，太好了！我佩服！值得我好好学习！

ykcbf1100

模糊查询经典用法

纯练手

ykcbf1100

练手。。。

1. Sub ykcbf()  '//2024.4.12
   
2.     Dim arr, brr
   
3.     c = 7
   
4.     ReDim a(1 To c), b(1 To c), ft(1 To c)
   
5.     With Sheets("录入表")
   
6.         For x = 1 To c
   
7.             a(x) = .Cells(3, x + 1): b(x) = x
   
8.         Next
   
9.   '      R = .Cells(Rows.Count, 2).End(3).Row
   
10.         arr = .Range("b6:h11")
    
11.         ReDim brr(1 To UBound(arr), 1 To 7)
    
12.         For i = 1 To UBound(arr)
    
13.             fft = 1
    
14.             For x = 1 To c
    
15.                 ft(x) = IIf(a(x) = Empty Or CStr(arr(i, b(x))) Like "*" & CStr(a(x)) & "*", 1, 0)
    
16.                 fft = fft * ft(x)
    
17.             Next
    
18.             If fft = 1 Then
    
19.                 m = m + 1
    
20.                 For j = 1 To UBound(arr, 2)
    
21.                     brr(m, j) = arr(i, j)
    
22.                 Next
    
23.             End If
    
24.         Next
    
25.         If m > 0 Then
    
26.             .[b13:h10000].ClearContents
    
27.             .[b13].Resize(m, 7) = brr
    
28.         End If
    
29.     End With
    
30.     MsgBox "OK！"
    
31. End Sub
    

复制代码