Как установить гибкий контейнер для получения ширины его содержимого? [Дубликат]

Небольшая модификация кода Jeeped.

Если вы используете подобный подход, но с несколькими таблицами (например, более 10), то будет довольно громоздко пытаться вручную добавить каждое имя каждой таблицы. Это также проблема, если вы меняете имена таблиц, поскольку имена в VBA жестко связаны. Чтобы избежать дополнительной работы, рассмотрите следующее:

Итак, предположим следующее:

• На каждом листе есть одна или несколько таблиц, но они имеют схожую структуру.
• На листах есть только таблицы - никаких других элементов коллекции ListObjects не присутствуют.
• Каждый раз, когда мы редактируем таблицу на листе, это вызывает обновление в главной таблице ( таблица 3).

Затем Subbook Workbook_SheetChange в приведенном выше примере может выглядеть следующим образом:

     Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
     Dim tbl As ListObject
     For Each tbl In ActiveSheet.ListObjects
        If Not Intersect(Target, tbl.Range.Offset(1, 0)) Is Nothing Then
            On Error GoTo bm_Safe_Exit
            Application.EnableEvents = False
            Call update_Table
        End If
        Next tbl
        bm_Safe_Exit:
        Application.EnableEvents = True
     End Sub

Изменить. Вторая процедура будет выглядеть так:

   Private Sub update_Table()
    Dim iTBL3rws As Long, rng As Range, rngOLDBDY As Range
    Dim tbl As ListObject
    Dim sht As Worksheet
    iTBL3rws = 0

    ' consider all tables, excluding master table
    For Each sht In ThisWorkbook.Worksheets
        For Each tbl In sht.ListObjects
            If tbl.Name <> "Table3" Then
                iTBL3rws = iTBL3rws + tbl.DataBodyRange.Rows.Count
            End If
        Next tbl
    Next sht

    iTBL3rws = iTBL3rws + Sheet3.ListObjects("Table3").DataBodyRange.Cells(1, 1).Row - Sheet3.ListObjects("Table3").Range.Cells(1, 1).Row
        With Sheet3.ListObjects("Table3")

            Set rngOLDBDY = .DataBodyRange

            .Resize .Range.Cells(1, 1).Resize(iTBL3rws, .DataBodyRange.Columns.Count)

            If rngOLDBDY.Rows.Count > .DataBodyRange.Rows.Count Then
                For Each rng In rngOLDBDY
                    If Intersect(rng, .DataBodyRange) Is Nothing Then
                        rng.Clear
                    End If
                Next rng
            End If
        End With

End Sub

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