VBA Изменение размера активированных ячеек в Excel

Question

Я знаю, что это дубликат, но 30 минут поиска в Google не могли найти ответ.

В Excel время от времени могут активироваться дополнительные ячейки или строки - обычно, заходя слишком далеко вниз на листе, «активируя» все 1M + строк.Это оказывает негативное влияние на производительность, как в памяти, размер файла и удобство использования.

Ранее я видел сообщение о том, как можно «изменить размер» того, что Excel считает активированной ячейкой, но я не могу ее найти.

Как изменить размер (с помощью VBA)активированные ячейки таблицы Excel, предпочтительно с использованием VBA?(Вы можете уничтожить и заново изготовить лист ... но я бы предпочел этого избежать)

Для ясности, я ссылаюсь на набор ячеек, которые Excel считает необходимым хранить и запоминать.Например, если вы перейдете к ячейке A1048576, поместите точку в ячейку, нажмете клавишу ввода, затем удалите ее и прокрутите вверх, Excel «Помнит», что все 1048576 строк теперь активированы и будут продолжать их сохранять.Вы можете сказать, что это происходит частично из-за полосы прокрутки.

Третий способ - я хотел бы переопределить, где в электронной таблице Excel меня берет, когда я нажимаю Ctr + End - он приводит вас к тому, что в данный момент он считает последней строкой и последним столбцом, ноэто неправильно, и я хотел бы напомнить Excel, каковы правильные границы.

Answer 1

Чтобы сбросить последнюю ячейку на листе с помощью VBA, вы можете использовать следующий код, который удалит избыточное форматирование:

Sub ClearExcessRowsAndColumns()
    Dim ar As Range, r As Long, c As Long, tr As Long, tc As Long, x As Range
    Dim wksWks As Worksheet, ur As Range, arCount As Integer, i As Integer
    Dim blProtCont As Boolean, blProtScen As Boolean, blProtDO As Boolean
    Dim shp As Shape

    If ActiveWorkbook Is Nothing Then Exit Sub

    On Error Resume Next
    For Each wksWks In ActiveWindow.SelectedSheets 'Applies only to selected sheets (can be more than one)
        Err.Clear
        Set ur = Nothing
        'Store worksheet protection settings and unprotect if protected.
        blProtCont = wksWks.ProtectContents
        blProtDO = wksWks.ProtectDrawingObjects
        blProtScen = wksWks.ProtectScenarios
        wksWks.Unprotect ""
        If Err.Number = 1004 Then
            Err.Clear
            MsgBox "'" & wksWks.Name & _
                   "' is protected with a password and cannot be checked." _
                 , vbInformation
        Else
            Application.StatusBar = "Checking " & wksWks.Name & _
                                    ", Please Wait..."
            r = 0
            c = 0

            'Determine if the sheet contains both formulas and constants
            Set ur = Union(wksWks.UsedRange.SpecialCells(xlCellTypeConstants), _
                           wksWks.UsedRange.SpecialCells(xlCellTypeFormulas))
            'If both fails, try constants only
            If Err.Number = 1004 Then
                Err.Clear
                Set ur = wksWks.UsedRange.SpecialCells(xlCellTypeConstants)
            End If
            'If constants fails then set it to formulas
            If Err.Number = 1004 Then
                Err.Clear
                Set ur = wksWks.UsedRange.SpecialCells(xlCellTypeFormulas)
            End If
            'If there is still an error then the worksheet is empty
            If Err.Number <> 0 Then
                Err.Clear
                If wksWks.UsedRange.Address <> "$A$1" Then
                    wksWks.UsedRange.EntireRow.Hidden = False
                    wksWks.UsedRange.EntireColumn.Hidden = False
                    wksWks.UsedRange.EntireRow.RowHeight = _
                    IIf(wksWks.StandardHeight <> 12.75, 12.75, 13)
                    wksWks.UsedRange.EntireColumn.ColumnWidth = 10
                    wksWks.UsedRange.EntireRow.Clear
                    'Reset column width which can also _
                     cause the lastcell to be innacurate
                    wksWks.UsedRange.EntireColumn.ColumnWidth = _
                    wksWks.StandardWidth
                    'Reset row height which can also cause the _
                     lastcell to be innacurate
                    If wksWks.StandardHeight < 1 Then
                        wksWks.UsedRange.EntireRow.RowHeight = 12.75
                    Else
                        wksWks.UsedRange.EntireRow.RowHeight = _
                        wksWks.StandardHeight
                    End If
                Else
                    Set ur = Nothing
                End If
            End If
            'On Error GoTo 0
            If Not ur Is Nothing Then
                arCount = ur.Areas.Count
                'determine the last column and row that contains data or formula
                For Each ar In ur.Areas
                    i = i + 1
                    tr = ar.Range("A1").Row + ar.Rows.Count - 1
                    tc = ar.Range("A1").Column + ar.Columns.Count - 1
                    If tc > c Then c = tc
                    If tr > r Then r = tr
                Next
                'Determine the area covered by shapes
                'so we don't remove shading behind shapes
                For Each shp In wksWks.Shapes
                    tr = shp.BottomRightCell.Row
                    tc = shp.BottomRightCell.Column
                    If tc > c Then c = tc
                    If tr > r Then r = tr
                Next
                Application.StatusBar = "Clearing Excess Cells in " & _
                                        wksWks.Name & ", Please Wait..."
                If r < wksWks.Rows.Count And r < wksWks.Cells.SpecialCells(xlCellTypeLastCell).Row Then
                    Set ur = wksWks.Rows(r + 1 & ":" & wksWks.Cells.SpecialCells(xlCellTypeLastCell).Row)
                    ur.EntireRow.Hidden = False
                    ur.EntireRow.RowHeight = IIf(wksWks.StandardHeight <> 12.75, _
                                                 12.75, 13)
                    'Reset row height which can also cause the _
                     lastcell to be innacurate
                    If wksWks.StandardHeight < 1 Then
                        ur.RowHeight = 12.75
                    Else
                        ur.RowHeight = wksWks.StandardHeight
                    End If
                    Set x = ur.Dependents
                    If Err.Number = 0 Then
                        ur.Clear
                    Else
                        Err.Clear
                        ur.Delete
                    End If
                End If
                If c < wksWks.Columns.Count And c < wksWks.Cells.SpecialCells(xlCellTypeLastCell).Column Then
                    Set ur = wksWks.Range(wksWks.Cells(1, c + 1), _
                                          wksWks.Cells(1, wksWks.Cells.SpecialCells(xlCellTypeLastCell).Column)).EntireColumn
                    ur.EntireColumn.Hidden = False
                    ur.ColumnWidth = 18

                    'Reset column width which can _
                     also cause the lastcell to be innacurate
                    ur.EntireColumn.ColumnWidth = _
                    wksWks.StandardWidth

                    Set x = ur.Dependents
                    If Err.Number = 0 Then
                        ur.Clear
                    Else
                        Err.Clear
                        ur.Delete
                    End If
                End If
            End If
        End If
        'Reset protection.
        wksWks.Protect "", blProtDO, blProtCont, blProtScen
        Err.Clear
    Next
    Application.StatusBar = False
    MsgBox "'" & ActiveWorkbook.Name & _
           "' has been cleared of excess formatting." & Chr(13) & _
           "You must save the file to keep the changes.", vbInformation
End Sub

ПРИМЕЧАНИЕ. Этот код был немногоадаптировано из кода, предоставленного в надстройке XSFormatCleaner от AKeeler.Раньше он был доступен в CodePlex до прекращения работы платформы ( Архив ).

Answer 2

Вы говорите о UsedRange

, чтобы уменьшить его, вам нужно

1) очистить все от диапазона (включая форматирование; вы можете просто удалить строки / столбцы)

2) сохранить документ