Мне нужна помощь по коду VBA для изменения размера таблиц Excel. Я написал макрос для заполнения данных в таблице Excel на том же листе и по всем листам. a) Данные извлекаются из базы данных
b) Имя таблицы базы данных представляет собой список. У пользователя есть возможность выбрать любую из перечисленных таблиц из выпадающего списка
c) После того, как пользователь нажмет Validate, заголовок таблицы заполняется именами столбцов, извлеченными из базы данных
d) Когда пользователь нажимает кнопку Import, данные таблицы заполняются
e) В зависимости от выбранного пользователем имени таблицы таблица Excel расширяется, чтобы вместить выбранный набор данных.
Пока все работает хорошо. Теперь проблема в
1) Если размер таблицы базы данных меньше, чем определено в таблице Excel, то мой Excel по-прежнему показывает дополнительные столбцы из предыдущей выборки.
Я пробовал несколько подходов, чтобы очистить содержимое дополнительных столбцов или удаление столбцов таблицы или воссоздание таблицы, но ни один из методов не выглядит хорошо и не создает мерцания на экране пользователя.
В поисках более чистого способа сброса / изменения размера таблицы как для расширения, так и для сжатия на основе количества столбцов, извлеченных из базы данных с сохранением исходного форматирования и стилей.
Любая помощь по этому вопросу приветствуется.
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 ammount 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