求VBA代码实现遍历整张表然后可以模糊查询

谢谢我插个队

遍历所有内容可以进行模糊查询，谢谢求帮忙

lsc900707

要求不具体，查询条件是什么？

谢谢我插个队

lsc900707 发表于 2018-8-24 09:26
要求不具体，查询条件是什么？

整行全部内容随机某列一个数据都可以查到   如：单位 “北京”就需要跳出全部与其相关的内容    如：规格查询“127*27”能找到全部127*27相关的内容

hefuqing

1. Sub 多条件工作表查询()
   
2. StartTime = Timer
   
3. Application.ScreenUpdating = False
   
4. Dim str$, str1$
   
5. Dim ran As Range
   
6. 
   
7. With ThisWorkbook.Sheets("查询")
   
8. Set ran = .Range("A5:j25000")
   
9. ran = ""
   
10. brr = .Range("A5:j25000")
    
11. crr = .Range("A2:j2")
    
12. End With
    
13. 
    
14.               Arr = Sheets(1).[a1].CurrentRegion
    
15.                    For j = 2 To UBound(Arr)
    
16.                        For i = 1 To UBound(crr, 2)
    
17.                            If crr(1, i) <> "" Then
    
18.                                str = str & "*" & UCase(crr(1, i)) & "*"
    
19.                                str1 = str1 & Arr(j, i)
    
20.                            End If
    
21.                        Next i
    
22. 
    
23.                          If str1 Like str And str <> "" Then
    
24.                              mm = mm + 1
    
25.                                For m = 1 To UBound(Arr, 2)
    
26.                                   brr(mm, m) = Arr(j, m)
    
27.                               Next m
    
28.                          End If
    
29.                              str1 = ""
    
30.                              str = ""
    
31.                 Next j
    
32. ThisWorkbook.Sheets("查询").Columns("b:z").NumberFormat = "@"
    
33. ran = "": ran = brr
    
34. TimeOne = Format(Timer - StartTime, "0.00000") & "秒"
    
35. Application.ScreenUpdating = True
    
36. MsgBox "查询时间：" & TimeOne
    
37. End Sub

复制代码

hefuqing

1. Sub 多条件工作表查询()
   
2. StartTime = Timer
   
3. Application.ScreenUpdating = False
   
4. Dim str$, str1$
   
5. Dim ran As Range
   
6. 
   
7. With ThisWorkbook.Sheets("查询")
   
8. Set ran = .Range("A5:j25000")
   
9. ran = ""
   
10. brr = .Range("A5:j25000")
    
11. crr = .Range("A2:j2")
    
12. End With
    
13. 
    
14.               Arr = Sheets(1).[a1].CurrentRegion
    
15.                    For j = 2 To UBound(Arr)
    
16.                        For i = 1 To UBound(crr, 2)
    
17.                            If crr(1, i) <> "" Then
    
18.                                str = str & "*" & UCase(crr(1, i)) & "*"
    
19.                                str1 = str1 & Arr(j, i)
    
20.                            End If
    
21.                        Next i
    
22. 
    
23.                          If str1 Like str And str <> "" Then
    
24.                              mm = mm + 1
    
25.                                For m = 1 To UBound(Arr, 2)
    
26.                                   brr(mm, m) = Arr(j, m)
    
27.                               Next m
    
28.                          End If
    
29.                              str1 = ""
    
30.                              str = ""
    
31.                 Next j
    
32. ThisWorkbook.Sheets("查询").Columns("b:z").NumberFormat = "@"
    
33. ran = "": ran = brr
    
34. TimeOne = Format(Timer - StartTime, "0.00000") & "秒"
    
35. Application.ScreenUpdating = True
    
36. MsgBox "查询时间：" & TimeOne
    
37. End Sub

复制代码

zopey

固定列  输入关键字是 普通的查询方法。
不固定列，一个字：懒。（懒人有懒招。）

谢谢我插个队

zopey 发表于 2018-8-24 15:47
固定列  输入关键字是 普通的查询方法。
不固定列，一个字：懒。（懒人有懒招。）

这位老师
见笑了

lsdongjh

1. Sub test()
   
2.     Dim SH As Worksheet
   
3.     Dim lngRows As Long, strFind As String
   
4.     Dim rgSource As Range, rgFind As Range, rgResult As Range
   
5.     Dim strAddress As String
   
6.    
   
7.     Set SH = Sheets("Sheet1")
   
8.     SH.Cells.EntireRow.Hidden = False
   
9.     lngRows = SH.Range("A" & Rows.Count).End(xlUp).Row
   
10.     Set rgSource = SH.Range("A2:J" & lngRows)
    
11.    
    
12.     strFind = Application.InputBox("请输入要查询的内容：", "查询")
    
13.    
    
14.     If strFind = "False" Or Trim(strFind) = "" Then Exit Sub
    
15.    
    
16.     strFind = Trim(strFind)
    
17.     Set rgFind = rgSource.Find(strFind, LookIn:=xlValues)
    
18.    
    
19.     If Not rgFind Is Nothing Then
    
20.         strAddress = rgFind.Address
    
21.         Do
    
22.             If rgResult Is Nothing Then Set rgResult = rgFind Else Set rgResult = Union(rgResult, rgFind)
    
23.             Set rgFind = rgSource.FindNext(rgFind)
    
24.         Loop While Not rgFind Is Nothing And rgFind.Address <> strAddress
    
25.         
    
26.         rgSource.EntireRow.Hidden = True
    
27.         rgResult.EntireRow.Hidden = False
    
28.         MsgBox "查询内容为【" & strFind & "】" & vbCrLf & "查找完毕，共找到【" & rgResult.Count & "】条记录！", vbInformation + vbOKOnly
    
29.     Else
    
30.         MsgBox "查询内容为【" & strFind & "】" & vbCrLf & "查找完毕，没有找到你要的记录！", vbCritical + vbOKOnly
    
31.     End If
    
32. End Sub
    

复制代码

Zamyi

查询条件为空时显示全部