把D列数字24修改大于24代码出错

chxw68

没看懂计算规则，猜测着修改了一下。

chxw68

baigangliao 发表于 2018-1-2 08:47
老师新年好：把随机产生数字放到到A1-A10里，有重复的，能够加一句代码去重吗

你的这段代码不是太好，你说说规则我重新写一段。

chxw68

1. Sub test()
   
2.   Dim r%, i%, c%, j%, m%, n%
   
3.   Dim arr, brr, crr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   Randomize Timer
   
7.   With Worksheets("sheet1")
   
8.     r = .Cells(.Rows.Count, 4).End(xlUp).Row
   
9.     arr = Application.Transpose(.Range("d1:d" & r))
   
10.     ReDim brr(1 To 33 - UBound(arr))
    
11.     For i = 1 To UBound(arr)
    
12.       d(arr(i)) = ""
    
13.     Next
    
14.     m = 0
    
15.     For i = 1 To 33
    
16.       If Not d.exists(i) Then
    
17.         m = m + 1
    
18.         brr(m) = i
    
19.       End If
    
20.     Next
    
21.     ReDim crr(1 To 10, 1 To 1)
    
22.     For i = 1 To UBound(crr)
    
23.       For x = 1 To UBound(arr) - 1
    
24.         m = x + 1 + Int(Rnd() * (UBound(arr) - x))
    
25.         temp = arr(x)
    
26.         arr(x) = arr(m)
    
27.         arr(m) = temp
    
28.       Next
    
29.       For x = 1 To UBound(brr) - 1
    
30.         m = x + 1 + Int(Rnd() * (UBound(brr) - x))
    
31.         temp = brr(x)
    
32.         brr(x) = brr(m)
    
33.         brr(m) = temp
    
34.       Next
    
35.       p = Int(Rnd * 3 + 4)
    
36.       q = 12 - p
    
37.       ReDim drr(1 To 33)
    
38.       For x = 1 To p
    
39.         drr(arr(x)) = 1
    
40.       Next
    
41.       For x = 1 To q
    
42.         drr(brr(x)) = 1
    
43.       Next
    
44.       ss = ""
    
45.       For x = 1 To UBound(drr)
    
46.         If drr(x) = 1 Then
    
47.           ss = ss & "," & x
    
48.         End If
    
49.       Next
    
50.       crr(i, 1) = Mid(ss, 2)
    
51.     Next
    
52.     .Range("a1").Resize(UBound(crr), 1) = crr
    
53.   End With
    
54. End Sub
    

复制代码

chxw68

重新写了一段代码，供楼主参考。

chxw68

修改好了。