Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2913|回复: 8

[已解决]关于随机排序的输出方式修改

[复制链接]
发表于 2014-8-10 07:46 | 显示全部楼层 |阅读模式
本帖最后由 dfshm 于 2014-8-10 17:32 编辑

附件 随机排序附件.rar (19.37 KB, 下载次数: 26)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2014-8-10 08:24 | 显示全部楼层
是我太笨了吗?
你的范例只有随机数,没见排序啊!
回复

使用道具 举报

 楼主| 发表于 2014-8-10 08:53 | 显示全部楼层
zjdh 发表于 2014-8-10 08:24
是我太笨了吗?
你的范例只有随机数,没见排序啊!

谢谢老师关注。这是基于第一行数据的随机排序。  第一行数据,是可变的,在300个之内(少时不足45个),数据基于1---49,数据之间有重复的。有时一个数据,会重复六到七次。
回复

使用道具 举报

发表于 2014-8-10 09:55 | 显示全部楼层
16384行能转成列吗??
回复

使用道具 举报

 楼主| 发表于 2014-8-10 10:01 | 显示全部楼层
zjdh 发表于 2014-8-10 09:55
16384行能转成列吗??

这个附件是03版的,改为07的,16384行,转置成列刚好到顶啊。
回复

使用道具 举报

发表于 2014-8-10 13:04 | 显示全部楼层
我就是针对你的2003版啊。
回复

使用道具 举报

 楼主| 发表于 2014-8-10 13:51 | 显示全部楼层
zjdh 发表于 2014-8-10 13:04
我就是针对你的2003版啊。

在03版下,把16384,设置成50即可。  相应16384后面的,五个00000,改为两个00。这样就输出的是50行。
回复

使用道具 举报

发表于 2014-8-10 17:07 | 显示全部楼层
这我知道
回复

使用道具 举报

发表于 2014-8-10 17:10 | 显示全部楼层    本楼为最佳答案   
  1. Const m& = 50, s$$ = "00"
  2. Sub kagawa()
  3.     Dim i&, j&, k&, n&, t, r,tms#
  4.     k = Val(InputBox("Please input Number of Data Sheets: " & m & " x ?", "GetRand", 1))
  5.     If k = 0 Then Exit Sub Else If m * k + 10 > Cells.Rows.Count Then k = (Cells.Rows.Count - 10) \ m
  6.     tms = Timer
  7.     arr = Application.Transpose(Application.Transpose([b1].CurrentRegion))
  8.     n = UBound(arr)
  9.     Workbooks.Add
  10.     With ActiveWorkbook
  11.         Do Until .Sheets.Count = 12
  12.             .Sheets.Add
  13.         Loop
  14.         For i = 1 To 12
  15.             .Sheets(i).Name = Right(0 & i, 2)
  16.         Next
  17.         Randomize
  18.         For k = 1 To 12
  19.             ReDim brr(1 To m, 1 To n)
  20.             For i = 1 To m
  21.                 For j = 1 To n
  22.                     r = Int(Rnd * (n - j + 1) + j)
  23.                     t = arr(r): arr(r) = arr(j): arr(j) = t: brr(i, j) = t
  24.                 Next
  25.             Next
  26.             .Sheets(Right(0 & k, 2)).Range("A1").Resize(n, m) = Application.Transpose(brr)
  27.         Next
  28.         .SaveAs (ThisWorkbook.Path & "" & "数据.xls")
  29.         .Close
  30.     End With
  31.     MsgBox Format(Timer - tms, "0.000s")
  32. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
dfshm + 3 很给力!

查看全部评分

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 00:39 , Processed in 1.448442 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表