2016-01-14 2 views
0

Я разрабатываю скрипт в VBA для Excel, и в настоящее время я работаю над удалением каждого листа, но «Jan2016», а затем копируя «Jan2016» и переименовывая его несколько раз. К сожалению, когда я запускаю свой код, моя функция DeleteAllButJanuary() случайным образом называется удалением каждого листа, кроме января, и заставляет его начинать и, в конечном счете, терпеть неудачу. Вот мой код:Как предотвратить случайный вызов этого кода

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 

Любое понимание будет оценено по достоинству.

+4

попробовать положить Application.EnableEvents = False в начале и Application.EnableEvents = True в конце GenerateData(). Это помогает? Я предполагаю, что у вас есть какой-то рабочий лист, активирующий событие, вызывающее многократное вызваемое имя. – sous2817

+3

Это была бы моя первая мысль, проверьте код за листами, посмотрите, есть ли какой-либо триггер deleteallbutjanuary, CTRL + F для него в вашем коде , –

+3

Используйте F8 для входа в макрос из редактора vba, затем продолжайте нажимать F8 для каждого шага. Вы должны быстро найти проблему. – nutsch

ответ

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 
+0

Еще одна проблема, которую я только что рассмотрел, - это попытка попытаться выполнить этот макрос в книгах которые содержат более 12 листов; массив «Месяцы» выдает ошибку, когда вы выйдете из диапазона при попытке доступа к членам, которые не существуют. Вам нужно будет добавить код обработки ошибок для этого, если это возможно – Tragamor

0

Надежда Я получил это право. Вы хотите удалить все листы, кроме января. Тогда вы хотите использовать это шаблон для повторного заполнения оставшихся месяцев? Правильно ли это? ...

Если да, то предлагаю вам удалить в обратном порядке ...

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 
Смежные вопросы