[已解决]百感交集--忽略空值

张雄友

百感交集--忽略空值，乱就是乱，但不是随机乱，是按行随机乱。

最佳答案

月排行榜 / 总排行榜

dsmch

2015-3-17 20:21

1. Sub dsmch()
   
2. Dim arr, brr, w, ww, i&, s%, n2%
   
3. arr = [a1:g12]: n2 = UBound(arr, 2)
   
4. ReDim brr(1 To UBound(arr), 1 To n2)
   
5. For i = 1 To UBound(arr)
   
6.     ReDim w(1 To n2): ReDim ww(1 To n2): s = 0
   
7.     For j = 1 To n2
   
8.         If arr(i, j) <> "" Then s = s + 1: w(s) = arr(i, j)
   
9.     Next
   
10.     If s = 0 Then Exit For
    
11.     For k = 0 To s - 1
    
12.         n = s - k
    
13.         y = Int(Rnd * n + 1)
    
14.         ww(k + 1) = w(y)
    
15.         w(y) = w(n)
    
16.     Next
    
17.     s = 0
    
18.     For j = 1 To n2
    
19.         If arr(i, j) <> "" Then s = s + 1: brr(i, j) = ww(s)
    
20.     Next
    
21. Next
    
22. [j1].Resize(UBound(brr), n2) = brr
    
23. End Sub

复制代码

跳转到最佳答案楼层

pengyx

用数组分别记录单元格名，和对应的数字，对数字乱序，单元格不乱。

dsmch

1. Sub dsmch()
   
2. Dim arr, brr, w, ww, i&, s%, n2%
   
3. arr = [a1:g12]: n2 = UBound(arr, 2)
   
4. ReDim brr(1 To UBound(arr), 1 To n2)
   
5. For i = 1 To UBound(arr)
   
6.     ReDim w(1 To n2): ReDim ww(1 To n2): s = 0
   
7.     For j = 1 To n2
   
8.         If arr(i, j) <> "" Then s = s + 1: w(s) = arr(i, j)
   
9.     Next
   
10.     If s = 0 Then Exit For
    
11.     For k = 0 To s - 1
    
12.         n = s - k
    
13.         y = Int(Rnd * n + 1)
    
14.         ww(k + 1) = w(y)
    
15.         w(y) = w(n)
    
16.     Next
    
17.     s = 0
    
18.     For j = 1 To n2
    
19.         If arr(i, j) <> "" Then s = s + 1: brr(i, j) = ww(s)
    
20.     Next
    
21. Next
    
22. [j1].Resize(UBound(brr), n2) = brr
    
23. End Sub

复制代码

张雄友

dsmch 发表于 2015-3-17 20:21

如果是按列乱时，不是换一下维度吗？行变列，列变行，但是怎么下标越界？

Sub dsmch()
Dim arr, brr, w, ww, i&, s%, n2%
arr = [a1:g12]: n2 = UBound(arr)
ReDim brr(1 To UBound(arr, 2), 1 To n2)
For i = 1 To UBound(arr, 2)
    ReDim w(1 To n2): ReDim ww(1 To n2): s = 0
    For j = 1 To n2
        If arr(i, j) <> "" Then s = s + 1: w(s) = arr(i, j)
    Next
    If s = 0 Then Exit For
    For k = 0 To s - 1
        n = s - k
        y = Int(Rnd * n + 1)
        ww(k + 1) = w(y)
        w(y) = w(n)
    Next
    s = 0
    For j = 1 To n2
        If arr(i, j) <> "" Then s = s + 1: brr(i, j) = ww(s)
    Next
Next
[j1].Resize(n2, UBound(brr)) = brr
End Sub

张雄友

朝露暮草 发表于 2015-3-17 20:34
哦，楼主说的这些平时很有帮助

是工作中用得到。

dsmch

1. Sub dsmch() '按列乱序
   
2. Dim arr, brr, w, ww, i&, j%, s&, n1&
   
3. arr = [a1:g12]: n1 = UBound(arr)
   
4. ReDim brr(1 To n1, 1 To UBound(arr, 2))
   
5. For j = 1 To UBound(arr, 2)
   
6.     ReDim w(1 To n1): ReDim ww(1 To n1): s = 0
   
7.     For i = 1 To n1
   
8.         If arr(i, j) <> "" Then s = s + 1: w(s) = arr(i, j)
   
9.     Next
   
10.     If s = 0 Then Exit For
    
11.     For k = 0 To s - 1
    
12.         n = s - k
    
13.         y = Int(Rnd * n + 1)
    
14.         ww(k + 1) = w(y)
    
15.         w(y) = w(n)
    
16.     Next
    
17.     s = 0
    
18.     For i = 1 To n1
    
19.         If arr(i, j) <> "" Then s = s + 1: brr(i, j) = ww(s)
    
20.     Next
    
21. Next
    
22. [j1].Resize(n1, UBound(brr, 2)) = brr
    
23. End Sub

复制代码

张雄友

dsmch 发表于 2015-3-17 20:21

选择A：E整列时，怎么没有数据出来？

张雄友

dsmch 发表于 2015-3-17 20:21

当A11：G11 全是空时，J12：P12 会没有数据出来。

dsmch

纠错处理出现错误，还是老实赋值数组吧
如果全为空，则循环下一步

1. Sub dsmch按行乱()
   
2. Dim arr, brr, w, ww, i&, s&, n2&
   
3. arr = [a2:e50]: n2 = UBound(arr, 2)
   
4. ReDim brr(1 To UBound(arr), 1 To n2)
   
5. For i = 1 To UBound(arr)
   
6.     ReDim w(1 To n2): ReDim ww(1 To n2): s = 0
   
7.     For j = 1 To n2
   
8.         If arr(i, j) <> "" Then s = s + 1: w(s) = arr(i, j)
   
9.     Next
   
10.     If s = 0 Then GoTo 100
    
11.     For k = 0 To s - 1
    
12.         n = s - k
    
13.         y = Int(Rnd * n + 1)
    
14.         ww(k + 1) = w(y)
    
15.         w(y) = w(n)
    
16.     Next
    
17.     s = 0
    
18.     For j = 1 To n2
    
19.         If arr(i, j) <> "" Then s = s + 1: brr(i, j) = ww(s)
    
20.     Next
    
21. 100:
    
22. Next
    
23. [h:l] = ""
    
24. [H2].Resize(UBound(brr), n2) = brr
    
25. End Sub

复制代码