匹配符合的内容

夯歌炜

jiminyanyan 发表于 2017-4-4 15:25
..........

大师，H1 单元格 是自定义的 （匹配到的个数），根据H1里的的数字来得到内容 比如我需要 匹配2个 的符合内容 那么只有 B4内容 优化匹配速度 是符合的 输出到C4，如果H1填写 0 那么B2：B4 没有符合的内容

jiminyanyan

夯歌炜 发表于 2017-4-4 15:56
大师，H1 单元格 是自定义的 （匹配到的个数），根据H1里的的数字来得到内容 比如我需要 匹配2个 的符合 ...

哦，我写反了，这题不难，留给其他坛友练练手吧．．．．．

夯歌炜

jiminyanyan 发表于 2017-4-4 16:13
哦，我写反了，这题不难，留给其他坛友练练手吧．．．．．

感谢大师的帮忙，我写的方法数据多就死机啦，具体功能大致就是 把B列的数据逐一在D:E列里查找，找到有就+1，得出找到的个数，然后符合H1里的个数就输出内容。

jiminyanyan

夯歌炜 发表于 2017-4-4 16:28
感谢大师的帮忙，我写的方法数据多就死机啦，具体功能大致就是 把B列的数据逐一在D:E列里查找，找到有就+ ...

Sub jimin()
    Dim arr, d1 As Object, d2 As Object, brr
    Dim crr(1 To 10000, 1 To 1)
    Set d1 = CreateObject("scripting.dictionary")
    Set d2 = CreateObject("scripting.dictionary")
    arr = Sheet1.Range("d2:e" & Sheet1.Range("d65535").End(xlUp).Row)
    For i = 1 To UBound(arr)
        d1(arr(i, 1)) = 1
        d2(arr(i, 2)) = 1
    Next
    brr = Sheet1.Range("b2:b" & Sheet1.Range("b65535").End(xlUp).Row)
    For i = 1 To UBound(brr)
        s = d1(Left(brr(i, 1), 3)) + d2(Right(brr(i, 1), 3))
        If s = Sheet1.Range("h1") Then
            crr(i, 1) = brr(i, 1)
        End If
    Next
    Sheet1.Range("c2:c10000").ClearContents
    Sheet1.Range("c2").Resize(UBound(crr), 1) = crr
End Sub

jiminyanyan

...........