Excel VBA动态工作表目录：表格无法随数据删除自动调整大小求助

你的核心问题是名为Directory的结构化表格在删除数据时无法自动收缩，仅新增数据时能正常扩展。可以用一行代码直接调整表格范围，同时覆盖新增、删除两种场景：

Sheet1.ListObjects("Directory").Resize Sheet1.Range("Directory[#Headers]").Resize(Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row - Sheet1.ListObjects("Directory").HeaderRowRange.Row + 1)

代码说明 #

• Sheet1.ListObjects("Directory")：获取目标表格对象（请根据实际情况替换Sheet1为表格所在工作表名称）
• Resize方法：重新定义表格的有效数据范围
• Range("Directory[#Headers]")：定位表格的表头行，作为范围起点
• Range("A" & Rows.Count).End(xlUp).Row：找到A列最后一行有数据的行号，以此确定表格需要收缩/扩展到的总行数

整合后的完整代码 #

把上述单行代码放到原代码的列宽自动调整之后，替换注释的表格调整部分，同时优化掉冗余的Select操作：

Sub update_directory()
Application.ScreenUpdating = False
Range("Directory").ClearContents
Range("AA1").Formula2R1C1 = "=TRANSPOSE(SheetNames)"
Sheet1.Calculate
Range("AA1").CurrentRegion.Copy
Range("A2").PasteSpecial Paste:=xlPasteValues
Range("AA1").CurrentRegion.Clear
Columns("A:B").EntireColumn.AutoFit
''Table Auto resize
Sheet1.ListObjects("Directory").Resize Sheet1.Range("Directory[#Headers]").Resize(Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row - Sheet1.ListObjects("Directory").HeaderRowRange.Row + 1)
Application.ScreenUpdating = True
End Sub

内容的提问来源于stack exchange，提问作者MKSS