Новости:

Подпишитесь на рассылку новых сообщений форума через службу рассылок: Subscribe.ru

Главное меню

Не срабатывает On Error GoTo...

Автор kim k., 11.11.2008, 17:30

« назад - далее »

kim k.

Добрый день!
Подскажите, возможно ли использование конструкции On Error GoTo <...> -- On Error GoTo 0 для перехода к различным меткам?
Например, в первом цикле эта конструкция используется для перехода к next i первого цикла, во втором -- к next i второго, в третьем -- к процедуре обработки ошибки, а в четвертом -- к концу саба?

У меня ситуация такого рода: в первом цикле я проверяю листы на соответствие "База" + номер базы и запоминаю, какой из номеров наибольший CurNumber = Right(CurName, Len(CurName) - 4). Во втором -- начиная с наибольшего я меняю названия листов на "База" + номер+1. Т.е. была База4 стала База5.
Все было хорошо, пока не возникла ситуация, когда один из листов копируется юзером -- тогда "База4" становится "База4 (1)". Тогда первый же цикл выдает ошибку 13 type mismatch когда CurNumber пытается вырезать скобочку. Я попытался обойти эту ошибку через On Error GoTo и поставил маркер перед Next i
Но ошибка продолжает выдаваться независимо от этого.
Вот кусок кода, который не хочет отлаживаться:
MaxNumber = 0
MaxNumber = 0
MaxNumber1 = 0
    For i = 1 To Sheets.Count
        Worksheets(i).Activate
        CurName = ActiveSheet.Name
        If StrComp(Left(CurName, 4), "база", vbTextCompare) = 0 Then
            If Len(CurName) > 4 Then
            CurNumber = Right(CurName, Len(CurName) - 4)
              If CurNumber > MaxNumber Then
                  MaxNumber = CurNumber
              End If
            End If
        Else
            If StrComp(Left(CurName, 2), "СТ", vbTextCompare) = 0 Then
            If Len(CurName) > 2 Then
    ' '''''''''''copied page CT(n)
                On Error GoTo MyErr
            CurNumber1 = Right(CurName, Len(CurName) - 2)
               If CurNumber1 > MaxNumber1 Then
                  MaxNumber1 = CurNumber1
              End If
            End If
        End If
    End If
MyErr:
On Error GoTo 0
    Next i

    If MaxNumber > MaxNumber1 Then
        MaxNumberTota = MaxNumber
    Else
        MaxNumberTota = MaxNumber1
    End If
               
    For j = 1 To MaxNumberTota
        For i = 1 To Sheets.Count
        Worksheets(i).Activate
        CurName = ActiveSheet.Name
        If StrComp(Left(CurName, 4), "база", vbTextCompare) = 0 Then
            If Len(CurName) > 4 Then
            CurNumber = Right(CurName, Len(CurName) - 4)
              If CurNumber = MaxNumber Then
                CurNumber = MaxNumber + 1
                ActiveSheet.Name = "База" & CurNumber
              End If
            End If
           
            Else
            If StrComp(Left(CurName, 2), "СТ", vbTextCompare) = 0 Then
            If Len(CurName) > 2 Then
      ' '''' workSheet Name CT(n)
            On Error GoTo MarkNext
            CurNumber1 = Right(CurName, Len(CurName) - 2)
              If CurNumber1 = MaxNumber1 Then
                CurNumber1 = MaxNumber1 + 1
                ActiveSheet.Name = "СТ" & CurNumber1
              End If
            End If
        End If
    End If
MarkNext:
    On Error GoTo 0
    Next i
    MaxNumber1 = MaxNumber1 - 1
    MaxNumber = MaxNumber - 1
    Next j

Заранее спасибо!

Prist

По-моему не хватает этих самых меток, к которым надо перейти в результате возникновения ошибки...
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
www.excel-vba.ru
Просто СПАСИБО [+оказать+]
Считаешь СПАСИБО мало? Яндекс.Деньги: 41001332272872; WM: R298726502453

Шпец Докапыч

До 89-и будет достаточно?

Sub SHD_NextValInNameSheet()
  For Each i In Sheets
    For n = 1 To Len(i.Name)
      svl = Mid(i.Name, n, 1)
      If svl Like "#" Then
        If CByte(svl) + 1 = 10 And flag Then
          svl = 0
          NewName = Left(NewName, Len(NewName) - 1) & _
                    CByte(Right(NewName, 1)) + 1
        Else
          svl = CByte(svl) + 1
        End If
        If flag And n <> 1 Then
          NewName = Left(NewName, Len(NewName) - 1) & _
                    CByte(Right(NewName, 1)) - 1
        End If
            flag = 1
      Else: flag = 0
      End If
      NewName = NewName & svl
    Next
   
    On Error Resume Next
    test = Sheets(Replace(NewName, "@", "")).Index
    On Error GoTo 0
    If test Then
      Sheets(Replace(NewName, "@", "")).Name = "@" & NewName
    End If
    If Left(NewName, 1) = "@" Then
      i.Name = Mid(NewName, 2, Len(NewName) - 1)
    Else
      i.Name = NewName
    End If
    NewName = "": test = 0
    If i.Index = Sheets.Count Then i.Name = Replace(i.Name, "@", "")
  Next
End Sub
Знания недостаточно, необходимо применение. Желания недостаточно, необходимо действие. (с) Брюс Ли

kim k.

Цитата: Prist от 11.11.2008, 18:00
По-моему не хватает этих самых меток, к которым надо перейти в результате возникновения ошибки...
MarkNext:
MyErr:

kim k.

Цитата: Шпец Докапыч от 11.11.2008, 19:11
До 89-и будет достаточно?

Sub SHD_NextValInNameSheet()
  For Each i In Sheets
    For n = 1 To Len(i.Name)
      svl = Mid(i.Name, n, 1)
      If svl Like "#" Then
        If CByte(svl) + 1 = 10 And flag Then
          svl = 0
          NewName = Left(NewName, Len(NewName) - 1) & _
                    CByte(Right(NewName, 1)) + 1
        Else
          svl = CByte(svl) + 1
        End If
        If flag And n <> 1 Then
          NewName = Left(NewName, Len(NewName) - 1) & _
                    CByte(Right(NewName, 1)) - 1
        End If
            flag = 1
      Else: flag = 0
      End If
      NewName = NewName & svl
    Next
   
    On Error Resume Next
    test = Sheets(Replace(NewName, "@", "")).Index
    On Error GoTo 0
    If test Then
      Sheets(Replace(NewName, "@", "")).Name = "@" & NewName
    End If
    If Left(NewName, 1) = "@" Then
      i.Name = Mid(NewName, 2, Len(NewName) - 1)
    Else
      i.Name = NewName
    End If
    NewName = "": test = 0
    If i.Index = Sheets.Count Then i.Name = Replace(i.Name, "@", "")
  Next
End Sub

Спасибо!!
мне решение понравилось!!!