[已解决]跪求大侠帮忙编段宏命令，用于自动采样记录结果

耶利米

各位大侠好，小弟新人求助，还望各位拔刀相助！具体需求如下：

Excel表 Range(B2:G2) 是一段数学模型的输出结果值，因为模型中有随机函数Randbetween，所以每次操作都会引起这几个单元格数值的变动。为了记录结果，我需要每次手动选中B2:G2，Ctrl+C 复制，再以黏贴值的方式黏贴到B4:G4记录此次结果（第三行留空）。完成黏贴后B2:G2变化，于是再次手动选中B2:G2，Ctrl+C 复制，再以黏贴值的方式黏贴到B5:G5记录结果。如此不停的copy B2:G2，逐行黏贴到B4，B5，B6.... 效率十分低下。我需要采集的样本量非常巨大，手工的方法根本无法满足要求。
还请各位古道热肠的大侠们指点一下，帮我编写一段宏，能够达到如下效果：

1、每执行一次宏，就会将一次结果的值黏贴一行，再执行一次，则顺序往下一行黏贴；（基本要求）
2、可以设定宏运行的次数，例如设定为100,000，则执行此宏后会自动记录100,000次的测试结果；（进阶要求）
3、黏贴时可以按照D2单元格的值排序，若本次结果的D2值相比过去采样的D2值小，则在原记录结果的第一行上再插入一行黏贴，始终保持D2值最小的那次结果在记录样本数据的最上方；（最终要求）

能够满足基本要求即可，如果三条都能满足那就真的感激不尽了~

【新人贴，如有不妥之处还请版主斧正，谢谢！】

最佳答案

月排行榜 / 总排行榜

金樽空对月

2016-1-15 09:19

见附件

跳转到最佳答案楼层

金樽空对月

建议上传个附件看一下，这样更有助于别人给出较合适的答案。
另外，每一次的所取出的值允许有重复的吗？

金樽空对月

见附件

金樽空对月

楼上的附件，是根据你的说明写的，如果数据量较大，只是取一些随机数据的话，建议你用下面这段代码，运行速度较快，这是直接在宏内取随机数，而不是在单元格内取数据，这样能大大提高运行速度的，你可以对比选择一下。

1. Sub mydata1()
   
2. Dim x, y, m, n, ar()
   
3. Dim str As String
   
4. str = InputBox("请输入运行的次数：", "数据输入")
   
5. If str = "" Then Exit Sub
   
6. n = Val(str)
   
7. ReDim ar(1 To n, 1 To 6)
   
8. For x = 1 To n
   
9.    For y = 1 To 6
   
10.       ar(x, y) = Application.WorksheetFunction.RandBetween(1, 10000)
    
11.    Next y
    
12. Next x
    
13. m = Sheet1.Cells(Rows.Count, 2).End(3).Row
    
14. Sheet1.Cells(m + 1, 2).Resize(n, 6) = ar
    
15. Z = Sheet1.Cells(Rows.Count, 2).End(3).Row
    
16. Sheet1.Range("b4:g" & Z + 1).Sort key1:=Sheet1.[d3], order1:=xlAscending
    
17. End Sub

复制代码

耶利米

感谢金樽兄的无私帮助~
两个宏都很好用，只是因为我的数据结果并非都是同样的随机取数，而是基于一个数学模型计算出的相关联结果，所以第二个宏内取随机的代码于我目前的需求而言不适用，只能用第一个从单元格取值，虽然慢一点但已经是大大提高效率了。