Настройка обработки ошибок VBA Перейти к определенной строке или метке? - PullRequest
0 голосов
/ 14 марта 2019

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

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

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

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

Спасибо !!!

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

On Error GoTo ErrSkip1:
lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Range("A1:O" & lr).AutoFilter Field:=12, Criteria1:="Item Merch Change"
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add(Range( _
"A2:A" & 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" & 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" & lr).AutoFilter Field:=12, Criteria1:="RD Change"
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add(Range( _
"A2:A" & 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" & 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 Ответ

2 голосов
/ 14 марта 2019

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

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

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

Set rng = Nothing 'if rng may already have been assigned
On Error Resume Next
Set rng = Range("A2:A" & 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...