动态修改表大小

Question

我编写了一个代码，在过滤了一些行后从其他工作表导入表格。我的问题是，当我超过此工作表中的表格行数时，它超过了表格。现在，我想知道是否有一种方法可以根据行数动态修改表格的大小。

Public Sub refresh()

Dim ws1 As Worksheet, ws2 As Worksheet, lr1 As Long, lRow As Long
    Set ws1 = ThisWorkbook.Worksheets("Scénarios de menace")
    Set ws2 = ThisWorkbook.Worksheets("Analyse de risque")
    Application.Calculation = xlCalculationAutomatic
    ws2.Range("B6:N" & ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row).ClearContents 
    lr1 = ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row
        ws1.Range("A1:A" & lr1).AutoFilter Field:=1, Criteria1:="x"
        ws1.Range("B3:N" & lr1).SpecialCells(xlCellTypeVisible).Copy
        ws2.Range("B6").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        ws1.Range("A6:A" & lr1).AutoFilter
        ws2.Activate: ws2.Cells(1, 1).Activate
End Sub

Answer 1

问题在于，如果知道表格的名称，调整表格的大小会更容易。

我在您的代码中添加了 3 行代码：

1. 获取粘贴数据使用的总范围
2. 为该总范围创建表格

3. 调整表格的大小（这里没有真正有用，因为表格刚刚设置）

   Public Sub refresh()
   
   Dim ws1 As Worksheet, ws2 As Worksheet, lr1 As Long, lRow As Long, ResultsRange As String
       Set ws1 = ThisWorkbook.Worksheets("Scénarios de menace")
       Set ws2 = ThisWorkbook.Worksheets("Analyse de risque")
       Application.Calculation = xlCalculationAutomatic
       ws2.Range("B6:N" & ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row).ClearContents
       lr1 = ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row
   
       ws1.Range("A1:A" & lr1).AutoFilter Field:=1, Criteria1:="x"
       ws1.Range("B3:N" & lr1).SpecialCells(xlCellTypeVisible).Copy
       ws2.Range("B6").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
       ws1.Range("A6:A" & lr1).AutoFilter
       ws2.Activate
       ws2.Cells(1, 1).Activate
   
       ResultsRange = "$B$6:$N$" & ws2.Range("B"& ws2.Rows.Count).End(xlUp).Row
       ws2.ListObjects.Add(xlSrcRange, Range(ResultsRange), , xlYes).Name = "Results_Table"
       ws2.ListObjects("Results_Table").Resize Range(ResultsRange)
   
   End Sub