如何控制查找到的数据的数量

无忧鸟

                      有时候由于查找到的数量过大影响工作效率，所以想控制一下查找到的数量，                比如现在输入“张三”可以查找到15个，现在工作需要想改为查找到“张三”的数量
                最多为10，代码怎么改？ 控制查找数量求助1.zip (27.19 KB, 下载次数: 9)

2020-2-6 18:32 上传

点击文件名下载附件

海好呀

加个判断后跳出，仅供参考
Sub CommandButton查找_Click1()
Set d = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
Sheet2.Activate
[a5:an4000].Clear
tj = [b3]
arr = Sheet1.UsedRange
For i = 1 To UBound(arr)
    For j = 1 To UBound(arr, 2)
   
        If arr(i, j) Like "*" & tj & "*" Then
        
            If Not d.exists(i) Then
                d(i) = ""
                r = r + 1
                For x = 1 To UBound(arr, 2)
                    arr(r, x) = arr(i, x)
                Next x
                If r >= 10 Then GoTo 100
            End If
        End If
    Next
    Next
100:00:00
If d.Count > 0 Then
    Sheet2.Cells(6, 1).Resize(r, UBound(arr, 2)) = arr
End If
Application.ScreenUpdating = True
Columns("a:a").NumberFormatLocal = "yyyy年m月d日"
End Sub

海好呀

仅供参考：

chjn2468

这个代码有BUG,当B3=陈胜时，结果有问题

YZC51

chjn2468 发表于 2020-2-6 22:01
这个代码有BUG,当B3=陈胜时，结果有问题

请参考
Sub CommandButton查找_Click1()
    Set d = CreateObject("scripting.dictionary")
    Application.ScreenUpdating = False
    Sheet2.Activate
    [a5:an4000].Clear
    tj = [b3]
    arr = Sheet1.UsedRange
    For i = 1 To UBound(arr)
        If arr(i, 2) Like "*" & tj & "*" Then
            For j = 1 To UBound(arr, 2)
                If Not d.exists(i) Then
                    d(i) = ""
                    r = r + 1
                    For x = 1 To UBound(arr, 2)
                        arr(r, x) = arr(i, x)
                    Next x
                End If
            Next
        End If
        If r >= 10 Then Exit For
    Next
    If d.Count > 0 Then
        Sheet2.Cells(6, 1).Resize(r, UBound(arr, 2)) = arr
    End If
    Application.ScreenUpdating = True
    Columns("a:a").NumberFormatLocal = "yyyy年m月d日"
End Sub

海好呀

chjn2468 发表于 2020-2-6 22:01
这个代码有BUG,当B3=陈胜时，结果有问题

你要看你的需求是什么，在一行里面包含还是某列里面包含某关键字，你查找陈胜他在了B列里面是张三，但AM列里面也是陈胜，所以他都查找出来了，只是需求不一样，我也不知道楼主的真实意思是某行里查找还是某列里查找，如有意思理解不对请谅解

无忧鸟

YZC51 发表于 2020-2-7 07:05
请参考
Sub CommandButton查找_Click1()
    Set d = CreateObject("scripting.dictionary")

您好，很感谢您的帮忙，但我之前是可以通过sheet记录表格的所有单元格查找数据的，现在按您的代码改后只能按B列的数据了，其它列的都不能查，麻烦再帮我改一下，谢谢

YZC51

无忧鸟 发表于 2020-2-7 21:00
您好，很感谢您的帮忙，但我之前是可以通过sheet记录表格的所有单元格查找数据的，现在按您的代码改后只 ...

我理解错误
Sub CommandButton查找_Click1()
    Set d = CreateObject("scripting.dictionary")
    Application.ScreenUpdating = False
    Sheet2.Activate
    [a5:an4000] = ""
    tj = [b3]
    arr = Sheet1.UsedRange
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            If arr(i, j) Like "*" & tj & "*" Then
                If Not d.exists(i) Then
                    d(i) = ""
                    r = r + 1
                    For x = 1 To UBound(arr, 2)
                        arr(r, x) = arr(i, x)
                    Next x
                End If
            End If
        Next
        If r >= 10 Then Exit For
    Next
    If d.Count > 0 Then
        Sheet2.Cells(6, 1).Resize(r, UBound(arr, 2)) = arr
    End If
    Application.ScreenUpdating = True
    Columns("a:a").NumberFormatLocal = "yyyy年m月d日"
End Sub

无忧鸟

YZC51 发表于 2020-2-7 21:10
我理解错误
Sub CommandButton查找_Click1()
    Set d = CreateObject("scripting.dictionary")

是我之前没说清楚，现在可以完美解决了，谢谢您！

YZC51

不客气！解决就好。