Excel表格大小调整-根据从数据库中获取的数据展开和收缩- VBA代码

a64a0gku  于 2023-04-22  发布在  其他
关注(0)|答案(1)|浏览(115)

我需要一些VBA代码的帮助来调整Excel表格的大小。我已经写了一个宏来填充同一工作表和跨工作表的Excel表格中的数据。a)数据是从数据库中拉
B)数据库表名是一个列表。用户可以从下拉列表中选择任何列出的表
c)一旦用户单击Validate,表头将填充从数据库获取的列名
d)当用户单击Import时,表数据被填充
e)基于用户对表名称的选择,excel表扩展以容纳所获取的数据集。
在此之前一切都很顺利现在的挑战是
1.如果数据库表的大小小于excel表中定义的大小,那么我的excel仍然会显示上一次提取的额外列。
我尝试了多种方法来清除额外列的内容或删除表列或重新创建表,但没有一种方法看起来很好,并在用户屏幕上创建 Flink 。
寻找更干净的方法来重置/调整表的大小,以根据从数据库中提取的列数进行扩展和收缩,并保持原始格式和样式。
任何在这方面的帮助都非常感谢。

Public Sub DeleteTableRows()
Dim table As ListObject
Dim SelectedCell As Range
Dim tableName As String
Dim ActiveTable As ListObject
Dim lastCol As Integer
Dim startCol As Integer ' Column index to start deleting the table after reset
Dim startRow As String ' Row name to select the start range for deleting table records
Dim objCount As Integer

 startCol = 0
 'select number of sheets want to this to run

Application.ScreenUpdating = False      'Prevent screen flickering while doing the refresh
For i = 2 To 4
If (i = 2) Or (i = 3) Then
    startCol = 7
    startRow = "A10"
ElseIf (i = 4) Then
    startCol = 7
    startRow = "A7"
End If

Sheets(i).Select

Range(startRow).Select
Set SelectedCell = ActiveCell
Selection.AutoFilter

'Determine if ActiveCell is inside a Table
On Error GoTo NoTableSelected
objCount = ActiveSheet.ListObjects.Count

tableName = SelectedCell.ListObject.Name
Set ActiveTable = ActiveSheet.ListObjects(tableName)
On Error GoTo 0

'Clear first Row
ActiveTable.DataBodyRange.Rows(1).ClearContents

'Delete all the other rows `IF `they exist
On Error Resume Next 
 
 ActiveTable.DataBodyRange.Offset(1,0).Resize (ActiveTable.DataBodyRange.Rows.Count - 1, _
 ActiveTable.DataBodyRange.Columns.Count).Rows.Delete
 Selection.AutoFilter
 On Error GoTo 0

Range(tableName & "[#Headers]").Select
' Range("Table4[#Headers]").Select
Selection.ClearContents

lastCol = ActiveSheet.ListObjects(tableName).Range.Columns.Count

'''''''''Autofit the columns'''''''''''

ActiveSheet.Columns("A:Z").AutoFit

'''''''''''''''delete Columns''''''''''
If (startCol < lastCol) And (i <> 4) Then
    Range(tableName & "[[#All],[Column" & startCol & "]:
 [Column" & lastCol & "]]").Select
    For j = startCol To lastCol
        Selection.ListObject.ListColumns(7).Delete
        Next j
    
End If

 'Execute to clear the 2nd table within the sheet as the above code is 
  handling only one table per sheet'''''
If (i = 4) Then
    Range(startRow).Select
    Set SelectedCell = Range("J7:S7")
    Selection.AutoFilter

    'Determine if ActiveCell is inside a Table
    On Error GoTo NoTableSelected
    objCount = ActiveSheet.ListObjects.Count

    tableName = SelectedCell.ListObject.Name
    Set ActiveTable = ActiveSheet.ListObjects(tableName)
    On Error GoTo 0
    Range(tableName & "[#Headers]").Select
    ' Range("Table4[#Headers]").Select
    Selection.ClearContents

    lastCol = ActiveSheet.ListObjects(tableName).Range.Columns.Count
    ActiveSheet.Columns("A:Z").AutoFit
End If
Next i

ThisWorkbook.Worksheets(2).Activate

Application.ScreenUpdating = True    

 Exit Sub
'Error Handling
NoTableSelected:
MsgBox "There is no Table currently selected!", vbCritical

End Sub
ql3eal8s

ql3eal8s1#

我相信这是一个MS错误。表随着数据的下降而扩展,但不收缩。我使用此代码来收缩表。

Dim whateverWorksForYou etc. 

    Address1 = ActiveSheet.Cells(RowCount, 20).Address
    Address2 = "$A$1" & ":" & Address1
    ActiveSheet.ListObjects("TableName").Resize Range(Address2)

相关问题