Excel VBA «On Error Resume Next» вызывает проблемы с переименованием заголовков таблиц

Question

Я хочу провести l oop через таблицы в рабочей книге и переименовать определенные заголовки столбцов в таблицах, чтобы расширенный фильтр мог копировать данные. В настоящее время я использую On Error Resume Next, чтобы избежать сообщений об ошибках, когда столбец не найден в таблице, а затем перейти к следующей таблице.

Хотя этот метод работает абсолютно нормально, он создает проблемы в дальнейшем вниз по коду, когда я пытался изменить размер таблицы. Изменение размера просто не сработало. С помощью @HTH стало очевидно, что проблема была On Error Resume Next после некоторых изменений кода.

Есть ли способ исправить On Error Resume Next, или я должен использовать другой метод для l oop пролистать таблицы и переименовать заголовки, пропуская таблицы, у которых нет этих указанных c заголовков?

Текущий релевантный код:

'Loop through and apply a change to all Tables in the Excel Workbook

Dim tbl As ListObject
Dim sht As Worksheet

'Loop through each sheet and table in the workbook
  For Each sht In wb.Worksheets
    For Each tbl In sht.ListObjects
        On Error Resume Next
            'rename headings
            tbl.ListColumns("Ranging").Name = "MS"
            tbl.ListColumns("Stock on Hand - Store").Name = "SOH"
        Next tbl
  Next sht

'Create Filter Criteria ranges
With MainWB.Worksheets.Add
    .Name = "FltrCrit"
    Dim FltrCrit As Worksheet
    Set FltrCrit = MainWB.Worksheets("FltrCrit")
End With

With FltrCrit
    Dim DerangedCrit As Range
    Dim DormantCrit As Range
    Dim OverstockCrit As Range
    Dim OutdatedCrit As Range
    Dim NegCrit As Range
    Dim myLastColumn As Long

    'Create Deranged Filter Criteria Range
    .Cells(1, "A") = "Deranged"
    .Cells(2, "A") = "MS"
    .Cells(3, "A") = "<>4"
    .Cells(2, "B") = "SOH"
    .Cells(3, "B") = "=0"

    'get last column, set range name
    With .Cells

        'find last column of data cell range
        myLastColumn = .Find(What:="*", After:=.Cells(2), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column

        'specify cell range
        Set DerangedCrit = .Range(.Cells(2, "A:A"), .Cells(3, myLastColumn))

    End With
End With

'Copy Filtered data to specified tables
Dim tblFiltered As ListObject
Dim copyToRng As Range, SDCRange As Range

'DERANGED
'Store Filtered table in variable
Set tblFiltered = wb.Worksheets("Deranged with SOH").ListObjects("Table_Deranged_with_SOH")

'Remove Filtered table Filters
tblFiltered.AutoFilter.ShowAllData

'Set Copy to range on Filtered sheet table
Set copyToRng = tblFiltered.HeaderRowRange
Set SDCRange = MainWB.Worksheets(2).ListObjects("Table_SDCdata").Range

'Use Advanced Filter
SDCRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=DerangedCrit, CopyToRange:=copyToRng, Unique:=False

'Resize filtered table to include new data
With wb.Worksheets("Deranged with SOH").Cells
        'find last row of source data cell range

        myLastRow = .Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 End With

With tblFiltered
        .Resize .HeaderRowRange.Resize(myLastRow - .HeaderRowRange.Rows(1).Row + 1)
End With

'Clear filter data on SDC
MainWB.Worksheets(2).ListObjects("Table_SDCdata").AutoFilter.ShowAllData

Answer 1

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

Public Function HeaderExists(table As ListObject, columnName As String) As Boolean
    On Error GoTo nope
    If Not table.ListColumns(columnName) Is Nothing Then
        HeaderExists = True
    End If
    Exit Function
nope:
    HeaderExists = False
End Function

, а затем заменить эту строку OERN на

For Each tbl In sht.ListObjects
        'rename headings
    if HeaderExists(tbl, "Ranging") then
        tbl.ListColumns("Ranging").Name = "MS"
    end if
    if HeaderExists(tbl, "Stock on Hand - Store") then
        tbl.ListColumns("Stock on Hand - Store").Name = "SOH"
    end if
Next tbl

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

Answer 2

Обработчик ошибок можно отключить с помощью:

  On Error GoTo 0

https://docs.microsoft.com/en-us/dotnet/visual-basic/language-reference/statements/on-error-statement

Если это вызывает проблемы в дальнейшем, это может быть связано с ошибкой но код возвращается к следующей строке из-за того, что обработчик ошибок остается активным до конца процедуры. Следующее будет применять обработчик ошибок только к l oop, а затем вы сможете отладить проблему изменения размера:

  On Error Resume Next
    For Each sht In wb.Worksheets
      For Each tbl In sht.ListObjects
            'rename headings
            tbl.ListColumns("Ranging").Name = "MS"
            tbl.ListColumns("Stock on Hand - Store").Name = "SOH"
        Next tbl
    Next sht
  On Error GoTo 0