[已解决]自动另存指定文件夹里

pjy07 · 发表于 2013-1-9 15:10

请老师们帮帮忙

自动另存指定文件夹里

1、电子表格里已经有个代码（宏），是随机生成1-12范围内6个不重复的数字。

2、按次电子表格界面里的“按钮1”就生成一次数据。

3、生成数据后要保存（另存为在指定文件里）一次，需要100份，这样要重复上面步骤，很麻烦。

如上所述：能否修改代码，按次电子表格界面里的“按钮1”就生成一次数据，并自动另存指定文件夹里；文件名以保存时间保存或者用1~100为文件名。

最佳答案

rinyxa

2013-1-9 20:20

Sub Macro1()
'Randomize Timer
Dim x, y, z, x1 As Integer
For x1 = 1 To 100
Dim wb As Workbook
Dim a(7) As Byte
Set wb = ThisWorkbook
For x = 3 To [N2] + 1
Cells(x, 1) = "第" & x - 2 & "组"
For y = 2 To 7
10: a(y) = Int(Rnd() * 12) + 1
For z = 2 To y - 1
If a(z) = a(y) Then GoTo 10
Next
Cells(x, y) = a(y)
Next
Next
If Len(Dir("C:\Documents and Settings\Administrator\桌面" & x1 & ".xls")) = 0 Then
wb.Save
wb.SaveCopyAs "C:\Documents and Settings\Administrator\桌面" & x1 & ".xls"
End If
Next
End Sub

复制代码

看看这样如何

zjdh · 发表于 2013-1-9 15:38

本帖最后由 zjdh 于 2013-1-9 15:47 编辑

1-12范围的不重复随机数.rar (10.86 KB, 下载次数: 12)

rinyxa · 发表于 2013-1-9 15:43

Sub Macro1()
'Randomize Timer
Dim x, y, z, x1 As Integer
Dim wb As Workbook
Dim a(7) As Byte
Set wb = ThisWorkbook
For x = 3 To [N2] + 1
Cells(x, 1) = "第" & x - 2 & "组"
For y = 2 To 7
10: a(y) = Int(Rnd() * 12) + 1
For z = 2 To y - 1
If a(z) = a(y) Then GoTo 10
Next
Cells(x, y) = a(y)
Next
Next
For x1 = 1 To 100
If Len(Dir("C:\Documents and Settings\Administrator\桌面" & x1 & ".xls")) = 0 Then
wb.Save
wb.SaveCopyAs "C:\Documents and Settings\Administrator\桌面" & x1 & ".xls"
Exit Sub
End If
Next
End Sub

复制代码

看看是否合您的意

hwc2ycy · 发表于 2013-1-9 15:45

本帖最后由 hwc2ycy 于 2013-1-9 15:54 编辑

复制代码

hwc2ycy · 发表于 2013-1-9 15:56

你这100个备份，我电脑还真是吃不消了，

pjy07 · 发表于 2013-1-9 18:21

zjdh 发表于 2013-1-9 15:38
生成文件存放在同一目录下。

非常感谢！
你的代码只是自动另存1~100，但是我要100份，就要按下“按钮”100次，这样也很麻烦，能否按下“按钮”就自动生成100份文件在指定文件夹里。
谢谢！

pjy07 · 发表于 2013-1-9 18:23

rinyxa 发表于 2013-1-9 15:43
看看是否合您的意

非常感谢！
你的代码只是自动另存1~100，但是我要100份，就要按下“按钮”100次，这样也很麻烦，能否按下“按钮”就自动生成100份文件在指定文件夹里。
谢谢

rinyxa · 发表于 2013-1-9 20:20

Sub Macro1()
'Randomize Timer
Dim x, y, z, x1 As Integer
For x1 = 1 To 100
Dim wb As Workbook
Dim a(7) As Byte
Set wb = ThisWorkbook
For x = 3 To [N2] + 1
Cells(x, 1) = "第" & x - 2 & "组"
For y = 2 To 7
10: a(y) = Int(Rnd() * 12) + 1
For z = 2 To y - 1
If a(z) = a(y) Then GoTo 10
Next
Cells(x, y) = a(y)
Next
Next
If Len(Dir("C:\Documents and Settings\Administrator\桌面" & x1 & ".xls")) = 0 Then
wb.Save
wb.SaveCopyAs "C:\Documents and Settings\Administrator\桌面" & x1 & ".xls"
End If
Next
End Sub

复制代码

看看这样如何

zjdh · 发表于 2013-1-9 20:50

本帖最后由 zjdh 于 2013-1-9 20:55 编辑

pjy07 发表于 2013-1-9 18:23
非常感谢！
你的代码只是自动另存1~100，但是我要100份，就要按下“按钮”100次，这样也很麻烦，能否按下 ...

你试过没有？？！！

填写需要的份数，按一次按钮全部生成啊！！并且内容各不相同！！
就是1000份也只要按一次！！！

pjy07 · 发表于 2013-1-11 17:08

rinyxa 发表于 2013-1-9 20:20
看看这样如何

非常感谢！
非常感谢！

		自动登录	找回密码
密码			注册