Question

我试图将数据范围从工作表上的一个表复制到另一个工作表中另一个表上的数据范围。我不想采用标题内容，理想情况下我想弄清楚如何删除最左边的列，但我需要它来过滤。

我试图弄清楚如何调整表格的大小我试图根据表格的大小来粘贴值，而不是复制范围。

Sub AdjustedTablebyDistrict()
'Application.ScreenUpdating = False

Dim i As Integer

Dim tbl As ListObject
Dim tbl2 As ListObject
Dim tbl3 As ListObject
Dim tbl4 As ListObject

'Identify tables for paste job
Set tbl = Worksheets("BaseSheet").ListObjects("Table1")
Set tbl2 = Worksheets("BaseSheet").ListObjects("Table2")
'Identify tables for copy job
Set tbl3 = Worksheets("Step7Table").ListObjects("Step7")
Set tbl4 = Worksheets("Step2Table").ListObjects("Table4")

'Set to number of (districts -1) Currently 48
 For i = 0 To 9

Dim districtName As Range

With tbl3

'Change Tables based on selected District from dropdown
Worksheets("BaseSheet").Range("T1") =     Worksheets("BaseSheet").Range("U2").Offset(i, 0)
Set districtName = Worksheets("BaseSheet").Range("T1")
ThisFile = districtName.Value

'Filter on selected district
tbl3.Range.AutoFilter _
    Field:=1, _
    Criteria1:=districtName


Dim rng As Range
'Find size of copy table
numRows = tbl3.DataBodyRange.Rows.SpecialCells(xlCellTypeVisible).Count
numCols = tbl3.Range.Columns.Count

'Resize table for paste
tbl2.Resize tbl2.Range.Resize(numRows, numCols)

tbl3.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy Destination:=tbl2

End With

Next i

'Application.ScreenUpdating = True
End Sub

编辑：能够找到获取范围并调整大小以运行的方法，但它无法正常运行。即使行的值变小，表也不会缩小。

Answer 1

代码行

tbl2.Resize tbl2.Range.Resize(numRows, numCols)

回答了我关于调整表格大小的初步问题。它最初是无效的，因为我试图直接调整表的大小而不首先指定调整大小。我的第二个错误，制作桌子＆＃34; Shrink＆＃34;是我自己的用户错误。

该表实际上已经变得更小但是从上一次运行中留下了剩余的数据。要改变这一点，我只需要添加

.DataBodyRange.ClearContents

下面是基于来自另一个工作表的过滤表操作表调整大小的完整代码。

Dim i As Integer

Dim tbl As ListObject
Dim tbl2 As ListObject
Dim tbl3 As ListObject
Dim tbl4 As ListObject

'Identify tables for paste job
Set tbl = Worksheets("BaseSheet").ListObjects("Table1")
Set tbl2 = Worksheets("BaseSheet").ListObjects("Table2")
'Identify tables for copy job
Set tbl3 = Worksheets("Step7Table").ListObjects("Step7")

'Set to number of (districts -1) Currently 48
For i = 0 To 5

Dim districtName As Range
Dim ThisFile As String

With tbl3

'Change Tables based on selected District from dropdown
    Worksheets("BaseSheet").Range("T1") =           Worksheets("BaseSheet").Range("U2").Offset(i, 0)
    Set districtName = Worksheets("BaseSheet").Range("T1")
    ThisFile = districtName.Value

'Filter on selected district
    Worksheets("Step7Table").Range("A1").AutoFilter _
        Field:=1, _
        Criteria1:=districtName

'Find size of copy table
    countRows = ((tbl3.DataBodyRange.Rows.SpecialCells(xlCellTypeVisible).Count / 3) + 1)
    'MsgBox (tbl3.DataBodyRange.Rows.SpecialCells(xlCellTypeVisible).Count) / 3

    numRows = countRows
    'numCols = tbl3.DataBodyRange.Columns.Count

'Resize table for paste
    tbl2.Resize tbl2.Range.Resize(numRows)

    tbl3.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy _
        Destination:=tbl2

    'Add total row
    tbl2.ShowTotals = True
    tbl2.TotalsRowRange(, 1) = "Total"
    'tbl2.TotalsRowRange(, 2).Formula =
    'Call save functionality for each district
    Call saveToExcel(ThisFile)
    With tbl2
    'Turn off total row for row resets. Currently counts as part of datarange
        .ShowTotals = False
    'Clear table so that is can be reformatted without leave legacy contents
        .DataBodyRange.ClearFormats
        .DataBodyRange.ClearContents
    End With
    'Turn off total row for row resets. Currently counts as part of datarange

End With

Next i

'Enables alert messages
Application.DisplayAlerts = True
'Refresh screen after code runs fully
Application.ScreenUpdating = True
End Sub

根据VBA中另一个工作表中的Filtered表调整表大小

1 个答案: