获取列中不包含的数字

YZC51

cqz1314 发表于 2019-10-20 21:29
老师，谢谢您，辛苦了

麻烦您能不能帮我做如下调整：

附件代码已经完善，可以不限制列数。需要附件的话，请花花鼓励下！

cqz1314

感谢 感谢
继续估计

YZC51

请参考
分类 修改.rar (18.24 KB, 下载次数: 5)

2019-10-21 21:09 上传

点击文件名下载附件

cqz1314

YZC51 发表于 2019-10-21 21:09
请参考

老师 昨天是手机回复的 不太方便

非常感谢

如果有空，帮我看看 能不把没有完成的，随机排列一下，
现在没有完成的表中，某项显示的是 1 2 3  5 6 8
                              想要的交效果是 5 1 2 6  8 3 就是随机的，
这样反馈时 不至于总把某个孩子放在最前边。

YZC51

cqz1314 发表于 2019-10-22 10:28
老师 昨天是手机回复的 不太方便

非常感谢

试试看吧！！

YZC51

凑了一个，没有优化
分类 修改-2.rar (20.48 KB, 下载次数: 10)

2019-10-23 08:44 上传

点击文件名下载附件

cqz1314

YZC51 发表于 2019-10-22 19:49
凑了一个，没有优化

谢谢
运行5次后就按顺序了
而且报错了

YZC51

cqz1314 发表于 2019-10-22 20:18
谢谢
运行5次后就按顺序了
而且报错了

26楼附件已经更新，请参考

cqz1314

YZC51 发表于 2019-10-22 21:00
26楼附件已经更新，请参考

谢谢
前8列正常使用了
太好了
第9列有数剧就出错了

我看代码里有3个模块都有用吗

能不能合到一起呢
分类 修改2.rar (19.7 KB, 下载次数: 3)

2019-10-22 22:30 上传

点击文件名下载附件

我最后要把这个功能 和其他也个合到一起

YZC51

cqz1314 发表于 2019-10-22 22:30
谢谢
前8列正常使用了
太好了

合并为一个过程啦！请参考
Sub test()
    Dim r%, i%
    Dim arr, brr
    Dim d() As Object
    With Sheet1
        If .[a1] = "" Then Exit Sub
        arr = .[a1].CurrentRegion.Value
        Range("a1").Resize(1, UBound(arr, 2) + 50) = ""
        Range("a1").Resize(1, UBound(arr, 2)) = arr
        col = UBound(arr, 2)
        ReDim d(1 To col)
        For i = 1 To col
            Set d(i) = CreateObject("scripting.dictionary")
        Next
        For j = 1 To UBound(arr, 2)
            For i = 1 To UBound(arr)
                d(j)(arr(i, j)) = ""
            Next
        Next
    End With
    With Sheet3
        r = .Cells(.Rows.Count, 1).End(xlUp).Row
        arr = .Range("a2:b" & r)
        ReDim brr(1 To UBound(arr), 1 To col + 1)
        For j = 1 To col
            m = 0
            For i = 1 To UBound(arr)
                If Not d(j).exists(arr(i, 1)) Then
                    m = m + 1
                    brr(m, j) = arr(i, 2)
               End If
            Next
        Next
        For i = 1 To UBound(arr)
            brr(i, col + 1) = Rnd
        Next
    End With
    With Sheet2
        hs = UBound(brr): ls = UBound(brr, 2)
        .UsedRange.Offset(1, 0).ClearContents
        .Range("a2").Resize(hs, ls) = brr
        .Range(.Cells(2, 1), .Cells(hs, ls)).Sort key1:=.Cells(2, ls), order1:=xlAscending, Header:=2
        .Columns(ls) = ""
        arr = .UsedRange.Offset(1, 0)
        r = UBound(arr, 1)
        c = UBound(arr, 2)
        ReDim brr(1 To r, 1 To c)
        For j = 1 To UBound(arr, 2)
            m = 0
            For i = 1 To r
                If Len(arr(i, j)) Then
                    m = m + 1
                    brr(m, j) = arr(i, j)
                End If
            Next
        Next
        .UsedRange.Offset(1, 0).ClearContents
        .Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr
        .[a1].Select
    End With
End Sub