Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
楼主: HYY514

[练习]数组随机数竟赛题

[复制链接]
发表于 2008-7-30 15:29 | 显示全部楼层

<p>
游客,如果您要查看本帖隐藏内容请回复
</p><p>只会这种,要十几秒,[em04]</p>
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
回复

使用道具 举报

发表于 2008-7-30 23:19 | 显示全部楼层
回复

使用道具 举报

发表于 2008-7-30 23:28 | 显示全部楼层
回复

使用道具 举报

发表于 2008-7-31 20:10 | 显示全部楼层

<p>我VBA是看书自学的,加上英文够呛,所以嘛。。。,但我很想参加你的课,现在加入可以吗?附:我编写的使用中的一段宏</p><p>Sub 设置()<br/>Application.ScreenUpdating = False<br/>Sheets("S").Select<br/>H1 = 2<br/>Sheets.Add<br/>ActiveSheet.Name = "S2"<br/>'以下为比较所需要的数据,并复制到另一工作表<br/>Sheets("S").Select<br/>L1 = InputBox("请输入开始的排数")<br/>Cells(1, 5) = L1<br/>A1 = Cells(1, 5) '开始的排数<br/>L2 = InputBox("请输入结束的排数")<br/>Cells(1, 5) = L2<br/>A2 = Cells(1, 5) '结束的排<br/>L3 = InputBox("请输入开始的框数")<br/>Cells(1, 5) = L3 '开始的框数<br/>A3 = Cells(1, 5)<br/>L4 = InputBox("请输入结束的框数")<br/>Cells(1, 5) = L4<br/>A4 = Cells(1, 5) '结束的框数<br/>For I1 = 2 To 7000<br/>A = Cells(I1, 5)<br/>If A = "" Then Exit For<br/>B1 = Val(Cells(I1, 7))<br/>B2 = Val(Cells(I1, 8))<br/>If B1 &gt;= A1 And B1 &lt;= A2 Then<br/>&nbsp;&nbsp;&nbsp; If B2 &gt;= A3 And B2 &lt;= A4 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Range(Cells(I1, 1), Cells(I1, 6)).Copy<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Sheets("S2").Select<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Range(Cells(H1, 1), Cells(H1, 6)).PasteSpecial<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; H1 = H1 + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Sheets("S").Select<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp; End If<br/>End If<br/>Next I1<br/>Sheets("S2").Select<br/>Columns("E:E").Select<br/>Selection.Delete Shift:=xlToLeft<br/>Columns("C:C").Select<br/>Selection.Delete Shift:=xlToLeft<br/>'改名<br/>H2 = L1 &amp; "排" &amp; L3 &amp; "至" &amp; L4 &amp; "框," &amp; L2 &amp; "排" &amp; L3 &amp; "至" &amp; L4 &amp; "框"<br/>ActiveSheet.Name = H2 '改名<br/>Range("A1") = "料号": Range("B1") = "名称"<br/>Range("C1") = "货位": Range("D1") = "系统数量"<br/>Range("E1") = "实盘数量": Range("F1") = "差异"<br/>Range("G1") = "备注"<br/>Range("G2").Select</p><p>Columns("A:A").Select<br/>Selection.Insert Shift:=xlToRight</p><p>'页面设置</p><p>With ActiveSheet.PageSetup<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .PrintTitleRows = "$1:$1"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .LeftHeader = "盘点人:"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .CenterHeader = "日期:"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .RightHeader = "抽查人:&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; "<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .CenterFooter = "第 &amp 页,共 &amp;N 页"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .LeftMargin = Application.InchesToPoints(0.26)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .RightMargin = Application.InchesToPoints(0.31)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .TopMargin = Application.InchesToPoints(0.72)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .BottomMargin = Application.InchesToPoints(0.49)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .HeaderMargin = Application.InchesToPoints(0.34)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .FooterMargin = Application.InchesToPoints(0.2)<br/>End With<br/>'设边框<br/>Range(Cells(1, 1), Cells(H1 - 1, 8)).Select<br/>Selection.RowHeight = 21<br/>Range(Cells(1, 1), Cells(H1 - 1, 8)).ShrinkToFit = True<br/>With Selection.Borders<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .LineStyle = xlContinuous<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Weight = xlThin<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .ColorIndex = xlAutomatic<br/>End With<br/>'按货位排序<br/>Cells.Select<br/>&nbsp;&nbsp;&nbsp; Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Key2:=Range("B2") _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:= _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; xlSortNormal, DataOption2:=xlSortNormal<br/>&nbsp;Range("A:A,D:D").Select<br/>&nbsp; With Selection<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .VerticalAlignment = xlCenter<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .ShrinkToFit = True<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .ReadingOrder = xlContext<br/>&nbsp; End With<br/>&nbsp;Range("A1") = "序号"</p><p>&nbsp;For I = 2 To H1 - 1<br/>&nbsp; Cells(I, 1) = I - 1<br/>&nbsp;Next I<br/>&nbsp;Columns("A:B").HorizontalAlignment = xlLeft<br/>&nbsp;Columns("A:A").ShrinkToFit = True<br/>&nbsp;Columns("D:D").ShrinkToFit = True<br/>&nbsp;Columns("C:C").ShrinkToFit = False<br/>&nbsp; Columns("E:E").NumberFormatLocal = "G/通用格式"<br/>&nbsp;Columns("A:A").ColumnWidth = 4<br/>&nbsp;Columns("B:B").ColumnWidth = 10<br/>&nbsp;Columns("C:C").ColumnWidth = 20.63<br/>&nbsp;Columns("D:D").ColumnWidth = 8<br/>&nbsp;Columns("E:E").ColumnWidth = 9<br/>&nbsp;Columns("F:F").ColumnWidth = 10<br/>&nbsp;Columns("G:G").ColumnWidth = 10<br/>&nbsp;Columns("H:H").ColumnWidth = 14.5<br/>'存储<br/>'H3 = "<a href="file://\\Wa_tongll\share\">\\Wa_tongll\share\</a>盘点\" &amp; H2 &amp; "盘点表.xls"<br/>' Sheets(H2).Select<br/>' Sheets(H2).Move<br/>'ActiveWorkbook.SaveAs Filename:=H3, FileFormat:=xlNormal, Password:= _<br/>'&nbsp;&nbsp;&nbsp; "", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False<br/>Range("A1").Select<br/>Application.ScreenUpdating = True<br/>End Sub<br/></p><p></p>
回复

使用道具 举报

发表于 2008-7-31 20:13 | 显示全部楼层

<p>我QQ:925382491</p><p>(SELECT,IF YOU=I,THEN I=YOU,ELSE,YOU=?,END IF)</p>
回复

使用道具 举报

发表于 2008-8-1 14:17 | 显示全部楼层

<p>
游客,如果您要查看本帖隐藏内容请回复
</p><p>这是个土方法,感觉这样随机下去,越到后面运行的时间越长,</p><p>努力再想些好方法.</p>
回复

使用道具 举报

发表于 2008-8-1 15:35 | 显示全部楼层

<p>Sub 随机数()<br/>Application.ScreenUpdating = False<br/>Dim X, Y<br/>For X = 1 To 65536<br/>&nbsp;&nbsp;&nbsp; Cells(X, 6) = X<br/>&nbsp;&nbsp;&nbsp; Next X<br/>For X = 65536 To 1 Step -1<br/>Y = Int(Rnd() * X + 1)<br/>Cells(X, 1) = Cells(Y, 6)<br/>Cells(Y, 6).Delete<br/>Next X<br/>Application.ScreenUpdating = True<br/>End Sub<br/></p><p>这是我又想到的一个方法,不过好像运行起来比我之前那傻办法还慢,</p><p>再研究一下</p><p>本来打算在数组里删的,感觉好像没有这方法,望知道的人指点一下</p>
回复

使用道具 举报

发表于 2008-8-1 20:22 | 显示全部楼层

游客,如果您要查看本帖隐藏内容请回复
回复

使用道具 举报

发表于 2008-8-2 21:14 | 显示全部楼层

<p>学习了</p>
回复

使用道具 举报

发表于 2008-8-3 17:16 | 显示全部楼层

游客,如果您要查看本帖隐藏内容请回复

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2025-8-15 21:03 , Processed in 0.125517 second(s), 7 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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