Question

我正在VBA中为excel开发一个脚本，目前我正在努力删除除“Jan2016”之外的所有工作表，然后复制“Jan2016”并重命名几次。不幸的是，当我运行我的代码时，我的DeleteAllButJanuary（）函数被随机调用，删除每个工作表，但是再次使用1月，并使其重新开始并最终失败。这是我的代码：

Sub GenerateData()
    Dim WS_Count As Integer
    Dim I As Integer
    Dim Jan As Integer
    Dim Months() As String
    Months = Split("Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec", ",")

    ' Set WS_Count equal to the number of worksheets in the active
    ' workbook.
    WS_Count = ActiveWorkbook.Worksheets.Count

    Call DeleteAllButJanuary

    For I = 2 To WS_Count
        ActiveWorkbook.Worksheets("Jan2016").Copy _
        After:=ActiveWorkbook.Worksheets("Jan2016")
        ActiveWorkbook.Worksheets(I).Name = Months(I) + "2016"
    Next I
End Sub

'Delete all sheets except the January Sheet
Sub DeleteAllButJanuary()
    Application.DisplayAlerts = False
    For Each ThisSheet In ActiveWorkbook.Worksheets
        If ThisSheet.Name <> "Jan2016" Then
            ThisSheet.Delete
        End If
    Next
End Sub

任何见解都将受到赞赏。

Answer 1

稍加编辑的代码，添加了一些进一步的错误检查

Sub GenerateData()
    If Not WorkSheetExists("Jan2016") Then Exit Sub

    Dim WS_Count As Integer, i As Integer, Jan As Integer
    Dim Months() As String
    Months = Split("Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec", ",")

    WS_Count = ActiveWorkbook.Worksheets.Count

    With ActiveWorkbook
        Application.DisplayAlerts = False
        For Each ThisSheet In .Worksheets
            If ThisSheet.Name <> "Jan2016" Then ThisSheet.Delete
        Next
        Application.DisplayAlerts = True

        For i = WS_Count To 2 Step -1
            .Worksheets("Jan2016").Copy After:=.Worksheets("Jan2016")
            .Worksheets(2).Name = Months(i - 1) + "2016"
        Next i
    End With
End Sub

Function WorkSheetExists(ByVal strName As String) As Boolean
   On Error Resume Next
   WorkSheetExists = Not ActiveWorkbook.Worksheets(strName) Is Nothing
End Function

Answer 2

希望我有这个权利。您想要删除除1月以外的所有工作表。那么你想用这个模板重新填充剩下的几个月？这是对的吗？...

如果是这样，建议您按相反顺序删除...

Option Explicit

Sub GenerateData()

    Dim I As Integer
    Dim Months() As String
    Months = Split("Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec", ",")

    Call DeleteAllButJanuary

    For I = UBound(Months) To LBound(Months) + 1 Step -1

        Call Worksheets("Jan2016").Copy(After:=Worksheets("Jan2016"))
        Worksheets(2).Name = Months(I) + "2016"

    Next I

End Sub

Public Sub DeleteAllButJanuary()

On Error Resume Next

Dim I As Integer
Application.DisplayAlerts = False

Call Sheets("Jan2016").Move(Sheets(1))
For I = Sheets.Count To 2 Step -1
    Sheets(I).Delete
Next
Application.DisplayAlerts = True

End Sub

如何防止随机调用此代码

2 个答案: