如何使用 VBA 在 Excel 中调整表格/ListObject 的大小

How to resize a table / ListObject in Excel, with VBA

提问by paul bica

How to remove empty rows and columns from a table using ListObject.Resizemethod

如何使用ListObject.Resize方法从表中删除空行和列

回答by paul bica

• The initial table row must remain the same, and the resulting range must overlap

• 初始表格行必须保持不变，结果范围必须重叠

If the UsedRange of the table is larger than the UsedRange of the sheet:

如果表的 UsedRange 大于工作表的 UsedRange：

• Empty columns on the left and right will be removed (if the table doesn't have headers)
• Empty rows will be removed only from the bottom

• 左边和右边的空列将被删除（如果表格没有标题）
• 空行将仅从底部删除

If the UsedRange of the table is smaller than the UsedRange of the sheet the table will be expanded to include:

如果表的 UsedRange 小于工作表的 UsedRange，则表将扩展为包括：

• all columns outside of the table UsedRange (left and right)
• all rows bellow the table UsedRange

• 表 UsedRange 之外的所有列（左侧和右侧）
• 表 UsedRange 下方的所有行

---

---

Sheet 1 contains one sample table - VBA code:

表 1 包含一个示例表 - VBA 代码：

Option Explicit

Public Sub resizeTables()

    resizeTableUsedRangeV1 ActiveSheet.ListObjects(1)

End Sub

---

---

Module 1:

模块一：

• version 1 - always resize the table
• version 2 - resize the table only if table UsedRange is different than sheet UsedRange

• 版本 1 - 始终调整表格大小
• 版本 2 - 仅当表 UsedRange 与表 UsedRange 不同时调整表的大小

---

---

Option Explicit

Public Sub resizeTableUsedRangeV1(ByRef tbl As ListObject)
    Dim ws As Worksheet, ur As Range, maxCell As Range
    Dim fr As Long, lr As Long         'first and last row on worksheet (used range)
    Dim fc As Long, lc As Long         'first and last column on worksheet (used range)

    If Not tbl Is Nothing Then
        Set ws = tbl.Parent
        Set ur = ws.UsedRange
        Set maxCell = GetMaxCell(ur)
        fr = ur.Row
        fc = ur.Column
        lr = maxCell.Row
        lc = maxCell.Column
        tbl.Resize ws.Range(ws.Cells(tbl.DataBodyRange.Row, fc), ws.Cells(lr, lc))
    End If
End Sub

---

---

Public Sub resizeTableUsedRangeV2(ByRef tbl As ListObject)
    Dim ws As Worksheet, ur As Range, tblRng As Range, maxCell As Range
    Dim fr As Long, lr As Long         'first and last row on worksheet (used range)
    Dim fc As Long, lc As Long         'first and last column on worksheet (used range)
    Dim frTbl As Long, fcTbl As Long   'first row and column in table (used range)
    Dim lrTbl As Long, lcTbl As Long   'last row and column in table (used range)

    If Not tbl Is Nothing Then
        Set ws = tbl.Parent
        Set ur = ws.UsedRange
        Set tblRng = tbl.DataBodyRange

        Set maxCell = GetMaxCell(ur)

        fr = ur.Row
        fc = ur.Column
        lr = maxCell.Row
        lc = maxCell.Column

        frTbl = tblRng.Row
        fcTbl = tblRng.Column
        lrTbl = frTbl + tblRng.Rows.Count - 1
        lcTbl = fcTbl + tblRng.Columns.Count - 1

        If fc <> fcTbl Or lr <> lrTbl Or lc <> lcTbl Then
            'first row of a table can not change
            tbl.Resize ws.Range(ws.Cells(frTbl, fc), ws.Cells(lr, lc))
        End If
    End If
End Sub

---

---

Public Function GetMaxCell(Optional ByRef rng As Range = Nothing) As Range
    'It returns the last cell of range with data, or A1 if Worksheet is empty
    Const NONEMPTY As String = "*"

    Dim lRow As Range, lCol As Range

    If rng Is Nothing Then Set rng = Application.ThisWorkbook.ActiveSheet.UsedRange
    If WorksheetFunction.CountA(rng) = 0 Then
        Set GetMaxCell = rng.Parent.Cells(1, 1)
    Else
        With rng
            Set lRow = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
                                   After:=.Cells(1, 1), _
                                   searchDirection:=xlPrevious, _
                                   searchOrder:=xlByRows)
            Set lCol = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
                                   After:=.Cells(1, 1), _
                                   searchDirection:=xlPrevious, _
                                   searchOrder:=xlByColumns)
            Set GetMaxCell = .Parent.Cells(lRow.Row, lCol.Column)
        End With
    End If
End Function

回答by Developer

Try this simple approach. Where (0, 0) is the starting point "A1", and (2, 3) represents 2 rows and 3 columns also from the starting point.

试试这个简单的方法。其中(0, 0)是起点“A1”，(2, 3)表示也是从起点开始的2行3列。

Sub ResizeMacro()

    With Sheet1
        .ListObjects("Table1").Resize .Range("A1").Offset(0, 0).Resize(2, 3)
    End With

End Sub