Оптимизировать макрос: очистить таблицу - PullRequest
0 голосов
/ 03 июля 2018

Я много работаю с таблицами Excel. Я использую очень простой макрос, чтобы очистить таблицу при попытке использовать формулы, другие макросы и т. Д. Поскольку я не хочу удалять указанные таблицы, я их блокирую. У меня есть от 5000 до 10000 ячеек для очистки, и это очень и очень долго, так как мой компьютер на самом деле не создан для такого рода задач.

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

Sub RaZ_activesheet_table()
Dim tbl As ListObject
Dim retour As Long
Dim c As Range
Application.ScreenUpdating = False
retour = MsgBox(Prompt:="Vider les tableaux?", Buttons:=vbOKCancel)
If retour = vbOK Then
For Each tbl In ActiveSheet.ListObjects
    For Each c In Range(tbl.Name)
        If c.Locked = False Then
            c.ClearContents
        End If
    Next c
Next tbl
End If
Application.ScreenUpdating = True
End Sub

1 Ответ

0 голосов
/ 03 июля 2018

Я нашел это решение. Это работает, если:

  1. Сначала вы разблокируете все свои ячейки
  2. Далее вы защищаете клетки, которые не хотите очищать
  3. И, наконец, вам нужно добавить защиту листа с обоими первыми опциями

enter image description here

После этого вы можете применить этот простой код:

sub test()
On Error Resume Next
    ActiveSheet.UsedRange.Value = vbNullString
On Error GoTo 0
end sub

В вашем случае у вас будет что-то вроде этого:

Sub RaZ_activesheet_table()

Dim tbl As ListObject
Dim retour As Long
Dim c As Range

Application.ScreenUpdating = False

retour = MsgBox(Prompt:="Vider les tableaux?", Buttons:=vbOKCancel)

    If retour = vbOK Then
        For Each tbl In ActiveSheet.ListObjects

            On Error Resume Next
                tbl.UsedRange.Value = vbNullString
            On Error GoTo 0

        Next tbl
    End If

Application.ScreenUpdating = True
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...