[已解决]随机排序并提取合格列数据的问题

阿丽儿

附件 随机排序并提取合格列数据附件.rar (32.22 KB, 下载次数: 7)

2015-8-20 09:26 上传

点击文件名下载附件
谢谢老师!

最佳答案

月排行榜 / 总排行榜

grf1973

2015-8-20 15:22

原代码是香川做的吧？代码26行--44行是新加进去的，用于判断并生成结果数组。46--49行是原代码中生成工作簿的语句，现注释掉。

跳转到最佳答案楼层

阿丽儿

原来就有两个过程,一个是生成数据,一个是提取合格数据.只因第一步随机生成要要保存的文件太大,而提取合格数据又要打开这些大文件,要费很多时间.所以想把第一次生成的文件----虚拟化.然后,在这些虚拟化的数据中操作.

爱疯

“这个附件,是对A列数据(1000行内,目前是250行),进行随机乱序.执行后,会生成16000列数据 ...”

比如，先将此需求较好实现之后，再谈其他。
一下子能将全部问题解决，固然最好。但希望也是最小的。

阿丽儿

爱疯 发表于 2015-8-20 11:20
“这个附件,是对A列数据(1000行内,目前是250行),进行随机乱序.执行后,会生成16000列数据 ...”

比如，先 ...

老师您好,谢谢您关注.

我新发的贴子.其实是两个部份:
第一个部分是生成随机数,共成生49个工作薄,每个工作薄16000列.这个过程,有现成的程序,是在论坛找到的,不知是哪位老师写的了.
第二个部分是在生成的49个工作薄中,提取符合要求的列数据.  这个也有现成的程序.是本坛qrf1973老师所写.

因为生成的49个文件,很大.生成过程中,要另存为工作薄,要花费很多时间.
提取列数据过程中,也要打开这些大文件,又要费很多时间.
这么说吧,生成与提取49个16.700KB的文件,大约需要一个小时左右.

而如果把生成随机数的过程简化,即不让它输出49个文件,让这49个文件挂起来(虚拟化--不知提法对不对),再用提取合格数据的代码,把合格列数据,提出来.这样,就免掉了两个费时间的过程,即保存文件与打开文件的过程.我估计,可以节省三分之二左右时间.

下面我附上两位老师的程序,一个是生成随机数的程序,一个是提取合格数据的程序,可供参考(原程序只提取三个标识,不提列数据)附件如下: 随机排序与结果查询附件.rar (37.35 KB, 下载次数: 6)

2015-8-20 12:10 上传

点击文件名下载附件

上清宫主

没细看。
为什么非要生成那么多个文件呢？这些文件还有其它作用？难道就不可以在生成数据的时候就进行判断，合适的保留、不合适的丢掉吗？

阿丽儿

上清宫主 发表于 2015-8-20 12:45
没细看。
为什么非要生成那么多个文件呢？这些文件还有其它作用？难道就不可以在生成数据的时候就进行判断 ...

我的想法就是在边生成数据时,边判断.但一定要分明是出自哪个工作薄与出自哪一列.

我那生成49个工作薄,应该是一种假设吧?这个我也说不好.
就是说:在生成数据与判断数据的时候,也是按顺序来的.该在第一个工作薄的数据,就标明该工作薄的编号.

虽然不用输出49个文件,但它们的编号不能丢掉.即判断合格列数据并提取出来后,要标明工作薄编号.

谢谢老师关注.

grf1973

1. Sub kagawa()
   
2.     Dim i&, j&, k&, m&, n&, r&, t&, tms#
   
3.     tms = Timer
   
4.    
   
5.     ar = [a1].CurrentRegion
   
6.     m = UBound(ar)
   
7.     ReDim a&(m - 1)
   
8.     For i = 1 To m
   
9.         a(i - 1) = ar(i, 1)
   
10.     Next
    
11.    
    
12.     Application.ScreenUpdating = False
    
13.     Application.DisplayAlerts = False
    
14.     Randomize
    
15.     c = 16000   '列数
    
16.     gs = 10     '生成的工作簿数
    
17.     ReDim arr&(m, 1 To c)
    
18.     ReDim brr(m + 5, 1 To c)
    
19.     For k = 1 To gs
    
20.         wName = Right(0 & k, 2) & ".xlsx"
    
21.         For j = 1 To c
    
22.             For i = 0 To m - 1
    
23.                 r = Int(Rnd * (m - i)) + i
    
24.                 t = a(r): a(r) = a(i): a(i) = t: arr(i, j) = t
    
25.             Next
    
26.             '''''''''''''''''''''''''  新增判断部分
    
27.             r = m: n = 0      'r是最末一行（有数据的下一行）
    
28.             For i = r To 3 * r / 4 - 1 Step -1     '只需判断最末一行至最末一行的3/4处
    
29.                 n = n + 1
    
30.                 If arr(i, j) = n And i > 3 * n Then     '倒数第n行数值为n
    
31.                     If arr(i - n, j) = n And arr(i - 2 * n, j) = n And arr(i - 3 * n, j) = n Then
    
32.                         p = p + 1
    
33.                         For kk = 0 To m - 1
    
34.                             brr(kk, p) = arr(kk, j)
    
35.                         Next
    
36.                         
    
37.                         brr(kk + 2, p) = n
    
38.                         brr(kk + 3, p) = wName
    
39.                         brr(kk + 4, p) = Split(Cells(1, j).Address, "$")(1)     '第j列的列号
    
40.                         Exit For
    
41.                     End If
    
42.                 End If
    
43.             Next
    
44.             '''''''''''''''''''''''''''''''''''''''
    
45.         Next
    
46. '        'Workbooks.Add
    
47. '        [a1].Resize(m, n) = arr
    
48. '        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "" & Right(0 & k, 2) & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    
49. '        ActiveWindow.Close
    
50. 
    
51.     Next
    
52.    
    
53.     If p > 0 Then
    
54.         Sheet2.Activate
    
55.         Sheet2.Cells.ClearContents
    
56.         Sheet2.[a1].Resize(m + 5, p) = brr
    
57.     End If
    
58.     Application.ScreenUpdating = True
    
59.     MsgBox Format(Timer - tms, "0.000s")
    
60. End Sub
    

复制代码

grf1973

原代码是香川做的吧？代码26行--44行是新加进去的，用于判断并生成结果数组。46--49行是原代码中生成工作簿的语句，现注释掉。

grf1973

生成工作簿数在第16行用变量gs控制。附件中gs=10，运行时间4-5秒左右，生成结果2--3列左右。

阿丽儿

grf1973 发表于 2015-8-20 15:22
原代码是香川做的吧？代码26行--44行是新加进去的，用于判断并生成结果数组。46--49行是原代码中生成工作簿 ...

原代码是香川老师做的.
谢谢老师帮助,再谢!