[已解决]维数计算不对

张雄友

维数计算不对，速度缓慢。

最佳答案

月排行榜 / 总排行榜

香川群子

2014-5-27 13:11

1. Sub DataRnd()
   
2.     Dim arr, i&, j&, k&, m&, n&, i1&, j1&, ii&, jj&, r&, s&, t, rw&, cl&, cnt&, tms#
   
3.    
   
4.     arr = [a1].CurrentRegion '原始数据读入数组arr
   
5.     rw = UBound(arr): cl = UBound(arr, 2): s = rw * cl
   
6.    
   
7.     cnt = InputBox("待抽取个数 Set Total Amount:", "", s): If cnt = 0 Then Exit Sub
   
8.     n = InputBox("设置分列列数 Set Columns n=:", "", 3): If n = 0 Then Exit Sub
   
9.     m = (cnt - 1) \ n '计算最大行数
   
10.     ReDim brr(m, n - 1) '定义输出结果的数组brr (注意下标是从0开始)
    
11.    
    
12.     tms = Timer
    
13.     Randomize
    
14.     For i = 0 To m '遍历行 (行优先)
    
15.         For j = 0 To n - 1 '遍历列
    
16.             r = Int(Rnd * (s - k)) + k '计算不重复随机位置 (按序号)
    
17.             ii = r \ cl + 1: jj = r Mod cl + 1 '换算为数组arr的实际对应坐标
    
18.             t = arr(ii, jj): arr(ii, jj) = arr(i1 + 1, j1 + 1): arr(i1 + 1, j1 + 1) = t '数组交换算法保证随机
    
19.             brr(i, j) = t: k = k + 1: If k = cnt Then Exit For '随机结果写入数组brr 直到最后一个时退出
    
20.             j1 = j1 + 1: If j1 = cl Then j1 = 0: i1 = i1 + 1 '计算数组arr中下一个起始位置
    
21.         Next
    
22.     Next
    
23.     MsgBox "数组计算耗时：" & Format(Timer - tms, " 0.000s"): tms = Timer
    
24.    
    
25.     [a1].Offset(, cl + 2).CurrentRegion = ""
    
26.     [a1].Offset(, cl + 2).Resize(m + 1, n) = brr
    
27.     MsgBox "输出结果耗时" & Format(Timer - tms, " 0.000s")
    
28. End Sub
    

复制代码

附件中代码无注释，无中文提示。

跳转到最佳答案楼层

香川群子

老张又在玩什么了？


问题是什么为啥不说明白？

张雄友

香川群子 发表于 2014-5-25 22:21
老张又在玩什么了？

谢谢关注，就是数据输出，从左到右输出，怎么 H33 单元还没有数据就向 F34输出了？

香川群子

显然你的数组位置计算是错误的。所以会这样。

香川群子

这样吧，老张你把你的要求认真说一下，我帮你重新写代码。

如果看你的代码猜测，一是麻烦（你的代码看着累！）二是怕误解（猜错）

ppp710715

对，先明确要求再说。

张雄友

香川群子 发表于 2014-5-26 08:37
这样吧，老张你把你的要求认真说一下，我帮你重新写代码。

如果看你的代码猜测，一是麻烦（你的代码看着 ...

请看附件说明。谢谢！

香川群子

1. Sub DataRnd()
   
2.     Dim arr, i&, j&, k&, m&, n&, i1&, j1&, ii&, jj&, r&, s&, t, rw&, cl&, cnt&, tms#
   
3.    
   
4.     arr = [a1].CurrentRegion '原始数据读入数组arr
   
5.     rw = UBound(arr): cl = UBound(arr, 2): s = rw * cl
   
6.    
   
7.     cnt = InputBox("待抽取个数 Set Total Amount:", "", s): If cnt = 0 Then Exit Sub
   
8.     n = InputBox("设置分列列数 Set Columns n=:", "", 3): If n = 0 Then Exit Sub
   
9.     m = (cnt - 1) \ n '计算最大行数
   
10.     ReDim brr(m, n - 1) '定义输出结果的数组brr (注意下标是从0开始)
    
11.    
    
12.     tms = Timer
    
13.     Randomize
    
14.     For i = 0 To m '遍历行 (行优先)
    
15.         For j = 0 To n - 1 '遍历列
    
16.             r = Int(Rnd * (s - k)) + k '计算不重复随机位置 (按序号)
    
17.             ii = r \ cl + 1: jj = r Mod cl + 1 '换算为数组arr的实际对应坐标
    
18.             t = arr(ii, jj): arr(ii, jj) = arr(i1 + 1, j1 + 1): arr(i1 + 1, j1 + 1) = t '数组交换算法保证随机
    
19.             brr(i, j) = t: k = k + 1: If k = cnt Then Exit For '随机结果写入数组brr 直到最后一个时退出
    
20.             j1 = j1 + 1: If j1 = cl Then j1 = 0: i1 = i1 + 1 '计算数组arr中下一个起始位置
    
21.         Next
    
22.     Next
    
23.     MsgBox "数组计算耗时：" & Format(Timer - tms, " 0.000s"): tms = Timer
    
24.    
    
25.     [a1].Offset(, cl + 2).CurrentRegion = ""
    
26.     [a1].Offset(, cl + 2).Resize(m + 1, n) = brr
    
27.     MsgBox "输出结果耗时" & Format(Timer - tms, " 0.000s")
    
28. End Sub
    

复制代码

附件中代码无注释，无中文提示。

张雄友

香川群子 发表于 2014-5-27 13:11
附件中代码无注释，无中文提示。

数据量多时，测试少了一个数，鄙人愚笨。

香川群子

张雄友 发表于 2014-5-27 19:48
数据量多时，测试少了一个数，鄙人愚笨。

你自己看，原始数据中有1个空白单元格，A1是空的。

这就是原因。

楼上问题附件中，你自己修改了代码：
s = Application.CountA(Sheet1.[a1].CurrentRegion)
因此计数时仅按照有内容的单元格进行计数，返回总数=262143个，
然后，在抽取时空白单元格占用了其中一个位置，因此只能得到=262143-1=262142个值。


既然是原始数据的问题，你自己解决吧。我的代码没有问题。

…………
按你现在的做法，有1个空格就会少1个数据，有10个空格就会少10个数据……