[已解决]求助：代码修改

缘一缘

以下代码执行后生成新建Excel文件文件名为日期加时间，现要求改为0001、0002…
                               
Sub yy()
For h = 1 To 5000
Dim i&, d, x$, zd1$, zd2$, a(1 To 6), y&, bb$, MyBook As Workbook
Application.ScreenUpdating = False
Set MyBook = Excel.Workbooks.Add
With MyBook.Sheets(1)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To 49
    x = Format(i, "00")
    d(x) = ""
Next
zd1 = "32": zd2 = "05"
a(3) = zd1: a(4) = zd2
d.Remove (zd1)
d.Remove (zd2)
.Columns("A:A").NumberFormatLocal = "00"
.Columns("c:c").NumberFormatLocal = "00"
.[c1].Resize(d.Count) = Application.Transpose(d.keys)
.[D1].Formula = "=rand()"
.[D1].AutoFill .[D1].Resize(d.Count)
d.RemoveAll
For y = 1 To 14
    .Range("C1:D47").Sort Key1:=.Range("D1"), Order1:=xlAscending, Header:=xlNo
    For i = 1 To 4
        a(1) = .[c1].Value
        a(2) = .[c2].Value
        a(5) = .[c3].Value
        a(6) = .[c4].Value
        bb = Join(a, " ")
        If Not d.exists(bb) Then
            d(bb) = ""
            .Cells(7 * y - 6, 1).Resize(6) = Application.Transpose(a)
        End If
    Next
Next
Application.ScreenUpdating = True
End With
MyBook.SaveAs Filename:=ThisWorkbook.Path & "\" & Date & Timer & ".xlsx"
MyBook.Close
Set MyBook = Nothing
Next h
End Sub

最佳答案

月排行榜 / 总排行榜

suye1010

2012-8-5 14:19

MyBook.SaveAs Filename:=ThisWorkbook.Path & "\" & Date & Timer & ".xlsx"
修改为
MyBook.SaveAs Filename:=ThisWorkbook.Path & "\" & format(h ,"0000") & ".xlsx"

跳转到最佳答案楼层

suye1010

MyBook.SaveAs Filename:=ThisWorkbook.Path & "\" & Date & Timer & ".xlsx"
修改为
MyBook.SaveAs Filename:=ThisWorkbook.Path & "\" & format(h ,"0000") & ".xlsx"