ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 647|回复: 8

[求助] 求助 查询区域中找不到关键词 报错中断问题

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-12-1 12:54 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
我需要做一个在多列区域中的查找某一个关键词,并把查找出的内容汇总到一起的工具,从论坛中找了一个例子,经过测试,可以实现相关功能,但是存在一个问题无法解决。

我想在另一个工作表(sheet3)中查找同一个关键词,输出到右侧另一个区域,例如x-aa列。也就是说同时在多个工作表中查找同一个关键词,然后显示查找出的表格所在行的内容。
但是当在查找区域中找不到关键词的时候,程序会报错。如图: image.png
image.png
而且,如果第一个表格查不到关键词,但中断,也不会在查找第二个表格。
请问该如何解决?

十分感谢!!

image.png

查询汇总.zip

371.37 KB, 下载次数: 9

TA的精华主题

TA的得分主题

发表于 2020-12-1 13:13 | 显示全部楼层
Sub db()
    Dim brr()
    arr = Sheets("生产记录").Range("b5:r" & [c65536].End(3).Row)
    s = [c3]
    If s = "" Then
        Range("b6:q" & [b65536].End(3).Row).ClearContents
        Exit Sub
    End If
    For i = 1 To UBound(arr)
        For j = 2 To 6
            If InStr(arr(i, j), s) >= 1 Then
                n = n + 1
                ReDim Preserve brr(1 To 16, 1 To n)
                For k = 1 To 16
                    brr(k, n) = arr(i, k)
                Next
                Exit For
            End If
        Next
    Next
    Range("b6:q" & [b65536].End(3).Row).ClearContents
    If n <> "" Then
        [b6].Resize(n, 16) = Application.Transpose(brr)
    Else
        Exit Sub
    End If
    Dim brr1()
    arr1 = Sheets("sheet3").Range("a2:f1000")
    If s = "" Then
        Range("x6:ad1000").ClearContents
        Exit Sub
    End If
    For i1 = 1 To UBound(arr1)
        For j1 = 2 To 6
            If InStr(arr1(i1, j1), s) >= 1 Then
                n1 = n1 + 1
                ReDim Preserve brr1(1 To 6, 1 To n1)
                For k1 = 1 To 6
                    brr1(k1, n1) = arr1(i1, k1)
                Next
                Exit For
            End If
        Next
    Next
    Range("x6:ad1000").ClearContents
    If n1 <> "" Then
        [x6].Resize(n1, 6) = Application.Transpose(brr1)
    End If
End Sub

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2020-12-1 13:20 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2020-12-1 13:26 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
Sub db()
    Dim brr()
    arr = Sheets("生产记录").Range("b5:r" & Range("c" & Rows.Count).End(3).Row)
    s = [c3]
    n = 0
    If s = "" Then
        Range("b6:q" & Range("b" & Rows.Count).End(3).Row).ClearContents
        Exit Sub
    End If
    For i = 1 To UBound(arr)
        For j = 2 To 6
        
            If InStr(arr(i, j), s) >= 1 Then
                n = n + 1
                ReDim Preserve brr(1 To 16, 1 To n)
                For k = 1 To 16
                    brr(k, n) = arr(i, k)
                 Next
                 
                 Exit For
            
            End If
           
        Next
    Next
    Range("b6:q" & [b65536].End(3).Row).ClearContents
    If n > 0 Then [b6].Resize(n, 16) = Application.Transpose(brr)
   
    Dim brr1()
     arr1 = Sheets("sheet3").Range("a2:f1000")
    If s = "" Then
        Range("x6:ad1000").ClearContents
        Exit Sub
    End If
    n1 = 0
    For i1 = 1 To UBound(arr1)
        For j1 = 2 To 6
        
            If InStr(arr1(i1, j1), s) >= 1 Then
                n1 = n1 + 1
                ReDim Preserve brr1(1 To 6, 1 To n1)
                For k1 = 1 To 6
                    brr1(k1, n1) = arr1(i1, k1)
                 Next
                 
                 Exit For
            
            End If
           
        Next
    Next
    Range("x6:ad1000").ClearContents
    If n1 > 0 Then [x6].Resize(n1, 6) = Application.Transpose(brr1)
End Sub

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2020-12-1 13:27 | 显示全部楼层
作为调整,供楼主参考

查询汇总.zip

377.72 KB, 下载次数: 11

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-12-1 13:37 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-12-1 13:39 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2020-12-1 13:48 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
把不用的表格删了, 用事件做的模糊查询, 参考下

查询汇总.7z

20.54 KB, 下载次数: 10

TA的精华主题

TA的得分主题

发表于 2020-12-1 14:16 | 显示全部楼层
Sub ttt()
Dim i&, arr, m&, n%, k%
k = 4
Sheets("生产记录").Select
i = [b65536].End(3).Row
arr = Range("b5:q" & i)
Sheets("求助页").Select
For m = 1 To UBound(arr)
For n = 1 To UBound(arr, 2)
If InStr(arr(m, n), [c3].Value) > 0 Then
k = k + 1
Cells(k, 2).Resize(1, UBound(arr, 2)) = WorksheetFunction.Index(arr, m, 1)
End If
Next
Next
End Sub
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-28 17:11 , Processed in 0.064477 second(s), 11 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表