Настройка обработки ошибок VBA для перехода к определенной строке или метке?

ProgramBox

Настройка обработки ошибок VBA для перехода к определенной строке или метке?

Post author:admin
Запись опубликована:28 мая, 2023
Post category:Вопросы по программированию

#excel #vba

Вопрос:

Я пытаюсь найти наилучший способ справиться с ситуацией, когда у меня может возникнуть ошибка, и если это произойдет, я бы хотел, чтобы код переходил либо к определенной строке в коде, либо к метке. Я пробовал несколько способов, но, похоже, у меня возникли проблемы. Либо полный сбой Excel при его запуске, либо мой on error goto <label> игнорируется.

Я пытаюсь сделать это для 4 разных экземпляров ошибок, и я рассматривал возможность использования функций, но я не уверен, что они будут делать то, что я хочу, поскольку это происходит при наличии ошибки, а если ошибки нет, то функция не будет запущена и, следовательно, код будет полностью пропущен.

Я должен также упомянуть, что ошибка заключается в том, что когда отфильтрованный критерий пуст, следовательно, в ячейках ничего нет, мой код «Добавить разрыв» выдает ошибку, что нет ячеек для просмотра.

Будем признательны за любые предложения или помощь!

Спасибо!!!

Вот с чем я работаю:

 On Error GoTo ErrSkip1:
lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Range("A1:O" amp; lr).AutoFilter Field:=12, Criteria1:="Item Merch Change"
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add(Range( _
"A2:A" amp; lr), xlSortOnFontColor, xlAscending, , xlSortNormal).SortOnValue.Color _
= RGB(153, 204, 0)
With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

'Add Break
Set rng = Range("A2:A" amp; lr).SpecialCells(xlCellTypeVisible)
    irow = rng.Row
    icol = rng.Column
Do
If Cells(irow   1, icol).Font.ColorIndex <> Cells(irow, icol).Font.ColorIndex Then
   Cells(irow   1, icol).EntireRow.Insert shift:=xlDown
   Cells(irow   1, icol).EntireRow.ClearFormats
   irow = irow   2
Else
   irow = irow   1
End If
'
Loop While Not Cells(irow, icol).Text = ""

ErrSkip1:
    Range("A2").Select
    ActiveSheet.ShowAllData

'Format and sort RD Changes
On Error GoTo ErrSkip2
lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Range("A1:O" amp; lr).AutoFilter Field:=12, Criteria1:="RD Change"
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add(Range( _
"A2:A" amp; lr), xlSortOnFontColor, xlAscending, , xlSortNormal).SortOnValue.Color _
= RGB(153, 204, 0)
With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

'Add Break
Set rng = Range("A2:A" amp; lr).SpecialCells(xlCellTypeVisible)
    irow = rng.Row
    icol = rng.Column
Do
If Cells(irow   1, icol).Font.ColorIndex <> Cells(irow, icol).Font.ColorIndex Then
   Cells(irow   1, icol).EntireRow.Insert shift:=xlDown
   Cells(irow   1, icol).EntireRow.ClearFormats
   irow = irow   2
Else
   irow = irow   1
End If
'
Loop While Not Cells(irow, icol).Text = ""

ErrSkip2:
  Range("A2").Select
  ActiveSheet.ShowAllData

1. On Error GoTo ErrSkip1 без :

2. Примечание: После первой ошибки Excel больше не будет перехватывать ее до тех пор, пока она не достигнет Resume строки.

3. Ваша процедура выполняет слишком много действий, и у вас «счастливый путь» переплетен с «путем ошибки» — используйте Exit Sub для выхода из процедуры после «счастливого пути», затем закодируйте обработку ошибок под этим: это гарантирует, что код обработки ошибок всегда выполняется только в состоянии ошибки. Каждый путь кода, который выполняется в состоянии ошибки, должен быть Resume либо к Next , либо к определенной метке; любая ошибка, выданная в состоянии ошибки, будет необработана и отправит все в огонь.

4. Пожалуйста, сделайте отступ! Раньше это называлось «спагетти-код»

5. @PatrickHonorez все еще работает…

Ответ №1:

Если ваша проблема заключается в этой строке:

 Set rng = Range("A2:A" amp; lr).SpecialCells(xlCellTypeVisible)

и разумно предположить, что могут быть случаи, когда все строки будут отфильтрованы, тогда было бы лучше сделать что-то вроде этого:

 Set rng = Nothing 'if rng may already have been assigned
On Error Resume Next
Set rng = Range("A2:A" amp; lr).SpecialCells(xlCellTypeVisible)
On Error Goto 0

If Not rng is nothing then
    'work with rng
Else
    'no visible rows...
End if

…и если это обычная задача, то вы можете упростить свой код, разделив его на функцию

 Function VisibleCells(rngIn as Range) As Range
    Dim rv As Range
    On Error Resume Next
    Set rng = rngIn.SpecialCells(xlCellTypeVisible)
    On Error Goto 0
    Set VisibleCells = rv
End Function