我需要一些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
1条答案
按热度按时间ql3eal8s1#
我相信这是一个MS错误。表随着数据的下降而扩展,但不收缩。我使用此代码来收缩表。