Страницы: 1
RSS
Удалить все формулы и значения кроме текстовых
 
Здравствуйте!

Прошу помочь по возможности в написании следующего макроса...
Есть потребность удалять формулы и значения кроме текстовых в выделенном диапазоне.
Я ориентировался на работу окна "Выделение группы ячеек" (F5).
Сначала записал макрос для констант, затем для формул - без галочки для текста.
К сожалению не смог прописать, чтобы две команды выполнялись сразу - т.е. сразу выделяли ячейки по условиям для констант и формул.
Получилось только выполнить сначала одну операцию, затем другую. Да и ещё прописать обход ошибки 1004, в случае если условия одной из команд не выполняются (т.е. данные отсутствуют):
Код
Sub ClearContent()
On Error Resume Next: en& = Err.Number
    Range("A1").Select
    Selection.SpecialCells(xlCellTypeConstants, 21).Select 'выделить все константы, кроме текста
    Selection.ClearContents 'удалить выделенное
    Range("A1").Select
    Selection.SpecialCells(xlCellTypeFormulas, 21).Select  'выделить все формулы, кроме текстовых
    Selection.ClearContents 'удалить выделенное
If en& = 0 Then Err.Clear
End Sub
В итоге получилось, что нужно, но условия действуют для всего листа, а хотелось бы только для выделенного диапазона.
Может кто подсказать, как это лучше сделать?
Мои наработки (пример, что получилось) в файле...
Благодарю!
 
Странно, прописал таким образом... вроде работало:
Код
Sub ClearContent()
On Error Resume Next: en& = Err.Number
    With Selection
      .SpecialCells(xlCellTypeConstants, 21).Select 'выделить все константы, кроме текста
      .SpecialCells(xlCellTypeFormulas, 21).Select  'выделить все формулы, кроме текстовых
      .ClearContents 'удалить выделенное
    End With
If en& = 0 Then Err.Clear
End Sub

А когда перезашёл в файл, стал удалять все выделенные ячейки - и текст тоже....
Изменено: Владимир Самара - 11.02.2017 02:38:29
 
Нашёл подходящий код:
Код
Sub ClearContent2()

Dim rCcells As Range, rFcells As Range
Dim rAcells As Range

    Set rAcells = Selection 'ActiveSheet.UsedRange - Установить переменную для всех используемых клеток, а не только для выделенных

    On Error Resume Next 'В случае отсутствия числовой формулы или константы
    'Установить переменную для всех числовых констант, кроме текста
    Set rCcells = rAcells.SpecialCells(xlCellTypeConstants, 21)
    'Установить переменную для всех числовых формул, кроме текста
    Set rFcells = rAcells.SpecialCells(xlCellTypeFormulas, 21)

    If rCcells Is Nothing And rFcells Is Nothing Then
       MsgBox "Рабочий лист не содержит значений и формул"
       End

    ElseIf rCcells Is Nothing Then
       Set rAcells = rFcells 'Формулы
    ElseIf rFcells Is Nothing Then
       Set rAcells = rCcells 'Константы
    Else
       Set rAcells = Application.Union(rFcells, rCcells) 'Выделяет константы вместе с формулами
    End If
    On Error GoTo 0

    rAcells.Select
    Selection.ClearContents 'удалить выделенное
End Sub
Жаль в исходнике не мой :) Я лишь малость переделал (чуток) :)
Автор: http://www.ozgrid.com/VBA/special-cells.htm
Благодарю всех, кто старался помочь!!! Совместными усилиями пришли к решению! :)
Добра всем и отдельно спецам форума! ;)
Страницы: 1
Наверх