Получить диапазон Listobject без спецификации листа

Ссылка на таблицу Excel, если ее рабочий лист неизвестен
  • Когда это полезно?

  • Когда есть excel-tables вероятность, что кто-то переименует excel-tables рабочий лист или переместит range таблицу на другой рабочий excel лист, поскольку вы обычно excel-macro хотите это сделать, например:

    Dim tbl As ListObject
    Set tbl = ThisWorkbook.Worksheets("Sheet1").Listobjects("Table1")
    
  • Во listobject втором случае даже использование range кодового названия листа не vba спасет, например:

    Set tbl = Sheet1.ListObjects("Table1")
    

Метод (компактный)

Sub TableByName()

    Const TableName As String = "Table1"

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code

    ' Prevent "RTE '1004': Method 'Range' of object '_Global' failed"
    ' when the wrong workbook is active:
    If Not wb Is ActiveWorkbook Then wb.Activate

    Dim tbl As ListObject
    
    On Error Resume Next
        Set tbl = Range(TableName).ListObject
    On Error GoTo 0
    
    If tbl Is Nothing Then Exit Sub ' table not found

    With tbl
        Debug.Print .Name, .Range.Worksheet.Name, .Range.Address, _
            .DataBodyRange.Address, .ListRows.Count, .ListColumns.Count
    End With
    
End Sub

Использование функции

Sub SetTableByNameExample()

    Const TableName As String = "Table1"

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code

    Dim tbl As ListObject: Set tbl = SetTableByName(wb, TableName)
    
    If tbl Is Nothing Then Exit Sub ' table not found
    
    With tbl
        Debug.Print .Name, .Range.Worksheet.Name, .Range.Address, _
            .DataBodyRange.Address, .ListRows.Count, .ListColumns.Count
    End With
    
End Sub

Function SetTableByName( _
    ByVal wb As Workbook, _
    ByVal TableName As String) _
As ListObject
    
    ' Prevent "RTE '1004': Method 'Range' of object '_Global' failed"
    ' when the wrong workbook is active:
    If Not wb Is ActiveWorkbook Then wb.Activate
    
    On Error Resume Next
        SetTableByName = Range(TableName).ListObject
    On Error GoTo 0

End Function

excel

vba

range

listobject

excel-tables

2022-11-28T06:19:40+00:00