含多个sheet表的工作簿，想进行关键字查询。

一苇渡姜 · 发表于 2016-2-25 09:46

如题，这是一个多sheeet的简单的档案管理文件，想通过“姓名”查询得到相关信息，例如查询“输入“姜”得到所有带姜字的行，输入”强“得到所有含”强“字的行。之前有人帮我设计的宏，有点问题，总容易出错，例如我输入”姜丹丹“，则可以查到”姜丹丹“的信息，而如果我输入”姜“，则会下标越界，等情况。请各位老师帮忙看看，是改进还是重新写个宏，不胜感激。PS：最好查询结果点击后可以直接跳转到所在sheet表的具体位置上去。PPS，如果有相关的模板可以参考的话，希望能给我看看，谢谢大家。

chxw68 · 发表于 2016-2-25 10:15

Sub test()
Dim i%, r%
Dim arr, brr(1 To 1000, 1 To 9)
Dim ws As Worksheet
key = InputBox("请输入姓名中的关键字：", "关键字查询", "姜")
If StrPtr(key) = 0 Then
Exit Sub
End If
m = 0
For Each ws In Worksheets
If ws.Name Like "####年" Then
With ws
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a3:i" & r)
For i = 1 To UBound(arr)
If InStr(arr(i, 2), key) <> 0 Then
m = m + 1
For j = 1 To UBound(arr, 2)
brr(m, j) = arr(i, j)
Next
End If
Next
End With
End If
Next
With Worksheets("查询")
.UsedRange.Offset(1, 0).Clear
If m > 0 Then
.Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr
End If
End With
End Sub

复制代码

chxw68 · 发表于 2016-2-25 10:16

这是一段很简单的代码，供楼主参考。

wj2368 · 发表于 2016-2-25 10:22

代码没有问题，问题是你的资料列必须达到10列

蓝桥玄霜 · 发表于 2016-2-25 10:23

Sub 模糊查询()
Dim Sh As Worksheet, arr, brr(), n%, i%, j%
Dim key
Sheet1.Range("A2:Z65536").ClearContents
Sheet1.Columns("D:D").NumberFormatLocal = "@"
key = InputBox("请输入姓名中的关键字：", "关键字查询", "姜")
If StrPtr(key) = 0 Then Exit Sub
For Each Sh In ThisWorkbook.Worksheets
If Sh.Name <> "查询" Then
arr = Sh.UsedRange
For i = 2 To UBound(arr)
If arr(i, 2) Like "*" & key & "*" Then
n = n + 1: ReDim Preserve brr(1 To 9, 1 To n)
For j = 1 To 9
brr(j, n) = arr(i, j)
Next
End If
Next
End If
Next
If n = 0 Then
MsgBox "没有找到有关“" & key & "”的信息。"
Else
Sheet1.Range("A2").Resize(UBound(brr, 2), UBound(brr)) = WorksheetFunction.Transpose(brr)
End If
End Sub

复制代码

dfdfsfds · 发表于 2016-2-25 10:28

本帖最后由 dfdfsfds 于 2016-2-25 10:30 编辑

档案查询_宏查询-调试.zip (309.09 KB, 下载次数: 110)

双击查询出来的姓名可以跳转

LMY123 · 发表于 2017-12-13 17:10

多表模糊查询

mingbing1234 · 发表于 2019-6-14 16:18

chxw68 发表于 2016-2-25 10:15

谢谢大神分享，支持一下！

		自动登录	找回密码
密码			免费注册

[求助] 含多个sheet表的工作簿，想进行关键字查询。

评分

评分

评分

评分

最新热点 /1