[已解决]批量生成随机数工作薄的问题

晓敏

附件 生成随机数工作薄附件.rar (64.48 KB, 下载次数: 8)

2017-7-7 19:28 上传

点击文件名下载附件
谢谢！

最佳答案

月排行榜 / 总排行榜

grf1973

2017-7-10 16:49

1. Sub 生成()
   
2.     Application.DisplayAlerts = False
   
3.     Dim brr(1 To 49), L, wb As Workbook
   
4.     For i = 1 To 49: brr(i) = i: Next
   
5.     hs = [a1] '行数
   
6.     For k = 1 To 5   '生成工作簿个数
   
7.         ReDim arr(1 To hs, 1 To 7)
   
8.         For i = 1 To hs
   
9.             crr = brr: L = 49
   
10.             For j = 1 To 7
    
11.                 p = Int(Rnd * L + 1)
    
12.                 arr(i, j) = crr(p)
    
13.                 crr(p) = crr(L)
    
14.                 L = L - 1
    
15.             Next
    
16.         Next
    
17.         Set wb = Workbooks.Add
    
18.         wb.Sheets(1).[a1].Resize(hs, 7) = arr
    
19.         wb.SaveAs ThisWorkbook.Path & "" & k & ".xlsx"
    
20.         wb.Close True
    
21.     Next
    
22.     Application.DisplayAlerts = True
    
23. End Sub

复制代码

跳转到最佳答案楼层

grf1973

1. Sub 生成()
   
2.     Application.DisplayAlerts = False
   
3.     Dim brr(1 To 49), L, wb As Workbook
   
4.     For i = 1 To 49: brr(i) = i: Next
   
5.     hs = [a1] '行数
   
6.     For k = 1 To 5   '生成工作簿个数
   
7.         ReDim arr(1 To hs, 1 To 7)
   
8.         For i = 1 To hs
   
9.             crr = brr: L = 49
   
10.             For j = 1 To 7
    
11.                 p = Int(Rnd * L + 1)
    
12.                 arr(i, j) = crr(p)
    
13.                 crr(p) = crr(L)
    
14.                 L = L - 1
    
15.             Next
    
16.         Next
    
17.         Set wb = Workbooks.Add
    
18.         wb.Sheets(1).[a1].Resize(hs, 7) = arr
    
19.         wb.SaveAs ThisWorkbook.Path & "" & k & ".xlsx"
    
20.         wb.Close True
    
21.     Next
    
22.     Application.DisplayAlerts = True
    
23. End Sub

复制代码