使用VBA实现Excel单列表格自适应至各表最后数据行的问题

原代码的问题在于使用了CurrentRegion，这个属性会选中表格所在位置的整个连续数据区域，而非单个表格列自身的最后非空行，所以所有表格都会被扩展到工作表的最后数据行。

针对20个单列表格的场景，推荐用遍历所有表格的方式实现，不用逐个指定表名，更高效且易维护。下面是改进后的代码：

Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Dim tbl As ListObject
    Dim lastRow As Long
    Dim targetSheet As Worksheet
    
    ' 指定目标工作表
    Set targetSheet = ThisWorkbook.Sheets("Sheet1")
    
    ' 遍历工作表中所有表格
    For Each tbl In targetSheet.ListObjects
        ' 找到当前表格列的最后非空行（从列底往上找）
        lastRow = targetSheet.Cells(targetSheet.Rows.Count, tbl.ListColumns(1).Range.Column).End(xlUp).Row
        
        ' 调整表格大小：从表格起始行到最后非空行，保持1列
        tbl.Resize targetSheet.Range(tbl.Range.Cells(1, 1), targetSheet.Cells(lastRow, tbl.ListColumns(1).Range.Column))
    Next tbl
    
    Application.ScreenUpdating = True
End Sub

关键代码说明 #

• For Each tbl In targetSheet.ListObjects：自动遍历Sheet1里的所有表格，不用手动写20个表名，减少重复代码
• lastRow = ...End(xlUp).Row：针对当前表格的唯一列，从工作表最底部往上找第一个非空单元格，得到该列的真实最后数据行
• tbl.Resize ...：直接指定表格的新范围，起始位置是表格的第一个单元格，结束位置是该列最后非空行的单元格，确保只扩展到自身列的最后数据行

额外提示 #

• 如果某些表格需要排除，可以在循环里加判断，比如If tbl.Name <> "要排除的表名" Then ...
• 测试时可以先关闭Workbook_Open触发，手动运行代码看效果，没问题再改回自动触发

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