请各位高手帮忙看看！筛选

ysd1234

        sheet2中A列的数字是sheet1中的行数，我想筛选出1到33的数字里哪几个数字是sheet2中A列数字所对应的sheet1中行数BCDEFG列数字里没有的数字！sheet2中红色的数字是我对应A5的数字手动筛选出来的结果，请高手帮忙看能不能一键就能算出要筛选出来的结果！先谢谢了！！！       B       C       D     E      F     G                                

       6        11        14        23        26        30
      2        3        6        14        31        32
      1        6        14        22        25        26
      1        7        22        24        26        31
      4        10        18        19        25        27
      9        10        11        12        15        32
      7        8        13        22        30        32
      2        3        13        20        22        24
      5        17        21        22        28        32
      1        17        18        19        25        29
上面这些数字就是 sheet2中A5的数字所对应的sheet1中行数BCDEFG列的数字，1到33的数字里只有16和33是上面这些数字没有的，所以16和33就是我筛选出来的结果！希望我这样列出来大家一看就能明白





补充内容 (2017-6-30 11:28):
问题已解决非常感谢蓝桥玄霜版主和lsc900707！

蓝桥玄霜

请见代码。

ysd1234

蓝桥玄霜 发表于 2017-6-25 10:26
请见代码。

谢谢！你这是图片啊，代码怎么复制啊？！能做成附件吗？

Tadis

ysd1234 发表于 2017-6-25 11:05
谢谢！你这是图片啊，代码怎么复制啊？！能做成附件吗？

免费解决问题，要求不要太多，再说自己输入一遍也是学习

ysd1234

Tadis 发表于 2017-6-25 11:29
免费解决问题，要求不要太多，再说自己输入一遍也是学习

就因为是小白啊，那些代码符号都不知道在哪？！

ysd1234

蓝桥玄霜 发表于 2017-6-25 10:26
请见代码。

按照你的代码输了一遍
Sub lqxs()
Dim arr, i&, brr, j&, y&, n&, s, aa
Dim d, d1, k
Set d = create0bject("scripting.dictionary")
Set d1 = create0bject("scripting.dictionary")
Application.ScreenUpdating = False
Sheet2.Activate
[b5:z500].ClearContents
arr = Sheet1.[a1].CurrentRegion
brr = [a5].CurrentRegion
For i = 1 To UBound(brr)
    For y = 1 To 33
        d1(y) = ""
    Next
    aa = Split(brr(i, 1), ",")
    For j = 0 To UBound(aa)
        n = Val(aa(j))
        For y = 2 To 7
            d(arr(n, y)) = ""
        Next
    Next
    k = d.key
    For j = 0 To UBound(k)
        If d1.exists(k(j)) Then d1.Remove k(j)
    Next
    Cells(i + 4, 2).Resize(1, d1.Count) = d1.keys
    d.RemoveAll: d1removeall
Next
Application.ScreenUpdating = True
End Sub
运行宏不对啊

lsc900707

ysd1234 发表于 2017-6-25 12:35
按照你的代码输了一遍
Sub lqxs()
Dim arr, i&, brr, j&, y&, n&, s, aa

抄个代码都不认真，还在这里嚷嚷：
Sub lqxs()
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
Sheet2.Activate
[b5:z500].ClearContents
arr = Sheet1.[a1].CurrentRegion
brr = [a5].CurrentRegion
For i = 1 To UBound(brr)
    For y = 1 To 33
        d1(y) = ""
    Next
    aa = Split(brr(i, 1), ",")
    For j = 0 To UBound(aa)
        n = Val(aa(j))
        For y = 2 To 7
            d(arr(n, y)) = ""
        Next
    Next
    k = d.Keys
    For j = 0 To UBound(k)
        If d1.exists(k(j)) Then d1.Remove k(j)
    Next
    Cells(i + 4, 2).Resize(1, d1.Count) = d1.Keys
    d.RemoveAll: d1.RemoveAll
Next
Application.ScreenUpdating = True
End Sub

ysd1234

lsc900707 发表于 2017-6-25 12:49
抄个代码都不认真，还在这里嚷嚷：
Sub lqxs()
Set d = CreateObject("Scripting.Dictionary")

太谢谢了！我抄了四五十分钟才炒好（中间有几次没抄对），眼睛都看花了，我都是按照上面一个一个抄的啊，怎么还是没抄对哦......

蓝桥玄霜

ysd1234 发表于 2017-6-25 13:52
太谢谢了！我抄了四五十分钟才炒好（中间有几次没抄对），眼睛都看花了，我都是按照上面一个一个抄的啊， ...

所以要让你抄代码：一是可以通过抄写代码学到很多书上学不到的知识；二是让你体会一下帮助你的人的辛劳：要下载你的附件，理解你的问题，编写相应的代码，并且测试这些代码，完成以后再发到网上。

grf1973

抄个不用字典的