Макрос "REPLACE_by_VAL"

Старая форма входа

Страница 1 из 1 1
Модератор форума: _Boroda_, китин

Макрос "REPLACE_by_VAL" (Заменить формулы на значения)

Макрос "REPLACE_by_VAL"

Alex_ST

Дата: Понедельник, 30.08.2010, 13:17 | Сообщение № 1

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3213

Репутация: 609 ±

Замечаний: 0% ±

2003

Макрос REPLACE_by_VAL позволяет в выбранном диапазоне в нескрытых ячейках заменить формулы на значения
[vba]

Код

Sub REPLACE_by_VAL()   '  в выбранном диапазоне в не скрытых ячейках заменить формулы на значения
     If TypeName(Selection) <> "Range" Then Exit Sub
     Dim iCell As Range, rRange As Range
     With ActiveSheet.Cells
        Set rRange = Intersect(Selection, ActiveSheet.UsedRange, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeFormulas))
     End With
     Application.ScreenUpdating = False
     For Each iCell In rRange
        iCell.Copy: iCell.PasteSpecial Paste:=xlValues: iCell.Font.Color = vbBlack
     Next
     Application.ScreenUpdating = True
     rRange.Select
End Sub

[/vba]

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

Alex_ST

Дата: Понедельник, 11.02.2013, 12:25 | Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3213

Репутация: 609 ±

Замечаний: 0% ±

2003

Полирнул старый макрос:
[vba]

Код

Private Sub Replace_by_VAL()   '  в выбранном диапазоне в не скрытых ячейках заменить формулы на значения
    On Error Resume Next
    With Intersect(ActiveWindow.RangeSelection.SpecialCells(xlCellTypeVisible), ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas))
       .Value = .Value
    End With
End Sub

[/vba]

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

Формуляр

Дата: Понедельник, 11.02.2013, 15:27 | Сообщение № 3

Группа: Друзья

Ранг: Ветеран

Сообщений: 832

Репутация: 255 ±

Замечаний: 0% ±

Excel 2003, 2013

Нет предела совершенству! biggrin

[vba]

Код

With ActiveWindow.RangeSelection.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeFormulas)

[/vba]

Excel 2003 EN, 2013 EN

Ответить

Alex_ST

Дата: Понедельник, 11.02.2013, 15:50 | Сообщение № 4

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3213

Репутация: 609 ±

Замечаний: 0% ±

2003

Упс!
Как-то я не сообразил, что у Range.SpecialCells(...) тоже в свою очередь должно быть .SpecialCells(...) и это вполне можно использовать вместо Intersect shy

Спасибо, Саш.
Ещё короче получилось:[vba]

Код

Private Sub Replace_by_VAL()   '  в выбранном диапазоне в не скрытых ячейках заменить формулы на значения
    On Error Resume Next
    With ActiveWindow.RangeSelection.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeFormulas)
       .Value = .Value
    End With
End Sub

[/vba]

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

_Boroda_

Дата: Четверг, 07.11.2013, 10:33 | Сообщение № 5

Группа: Админы

Ранг: Местный житель

Сообщений: 16714

Репутация: 6503 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Это у меня глюк или ...?
Запустите вышеприведенный макрос в приложенном файле. В объединенных ячейках значения получаются 5 и 2 или, как у меня, 5 и 5?

К сообщению приложен файл: 852456.xls (33.5 Kb)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

RAN

Дата: Четверг, 07.11.2013, 11:12 | Сообщение № 6

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

5 и 5

Быть или не быть, вот в чем загвоздка!

Ответить

Alex_ST

Дата: Четверг, 07.11.2013, 11:14 | Сообщение № 7

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3213

Репутация: 609 ±

Замечаний: 0% ±

2003

А ведь и правда лажа почему-то получается…
Не пойму, в каком случае? Анализировать и править код, к сожалению абсолютно некогда.
Саш, может быть ты подправишь?

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

RAN

Дата: Четверг, 07.11.2013, 12:02 | Сообщение № 8

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Леш, только для вас. Любой каприз...

[vba]

Код

Sub Replace_by_VAL()   '  в выбранном диапазоне в не скрытых ячейках заменить формулы на значения
      On Error Resume Next
      For Each Ar In ActiveWindow.RangeSelection.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeFormulas).Areas
      Ar.Value = Ar.Value
      Next
End Sub

[/vba]

Быть или не быть, вот в чем загвоздка!

Сообщение отредактировал RAN - Четверг, 07.11.2013, 12:59

Ответить

Alex_ST

Дата: Четверг, 07.11.2013, 12:29 | Сообщение № 9

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3213

Репутация: 609 ±

Замечаний: 0% ±

2003

Андрей, спасибо.
Ну конечно дело в .Areas… Вечно я про них забываю

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

tati_2000

Дата: Четверг, 07.11.2013, 13:34 | Сообщение № 10

Группа: Пользователи

Ранг: Новичок

Сообщений: 12

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

вот спасибо за макрос. Жаль что сразу всю книгу нельзя, только по диапазонам ячеек, но все равно выход. Большущее спасибо.

Ответить

Alex_ST

Дата: Четверг, 07.11.2013, 14:09 | Сообщение № 11

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3213

Репутация: 609 ±

Замечаний: 0% ±

2003

Правда, я вспомнил, что .SpecialCells имеет гнусное свойство: если была выделена только одна ячейка, то выделяются все ячейки листа, соответствующие критерию отбора.
Ну, для примера, напишите на листе формулы в нескольких ячейках, а потом выделите только одну из них и по F5 выберите только ячейки с формулами.
Выберутся все ячейки листа с формулами, а не та, которая была выбрана. Ну и формулы на значения процедура заменит на всём листе, а не только в Selection (что будет сопровождаться соответствующими выражениями пользователя)
Для борьбы с этим пришлось процедурку усложнить так:
[vba]

Код

Sub Replace_by_VAL()   '  в выбранном диапазоне в не скрытых ячейках заменить формулы на значения
    Dim rRng As Range, rAr As Range
    On Error Resume Next
    With ActiveWindow.RangeSelection.Cells
       If .Count = 1 Or .MergeCells Then
          .Item(1) = .Item(1).Value: .Item(1).Font.Color = vbBlack: Exit Sub
       Else
          Set rRng = .SpecialCells(xlCellTypeFormulas).SpecialCells(xlCellTypeVisible)
       End If
    End With
    If rRng Is Nothing Then Exit Sub
    For Each rAr In rRng.Areas: rAr.Value = rAr.Value: Next
    rRng.Select
    rRng.Font.Color = vbBlack
End Sub

[/vba]
но что-то, кажется, перемудрил...
А разбираться уже опять некогда.

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

СообщениеПравда, я вспомнил, что .SpecialCells имеет гнусное свойство: если была выделена только одна ячейка, то выделяются все ячейки листа, соответствующие критерию отбора.
Ну, для примера, напишите на листе формулы в нескольких ячейках, а потом выделите только одну из них и по F5 выберите только ячейки с формулами.
Выберутся все ячейки листа с формулами, а не та, которая была выбрана. Ну и формулы на значения процедура заменит на всём листе, а не только в Selection (что будет сопровождаться соответствующими выражениями пользователя)
Для борьбы с этим пришлось процедурку усложнить так:
[vba]

Код

[/vba]
но что-то, кажется, перемудрил...
А разбираться уже опять некогда.

Автор - Alex_ST
Дата добавления - 07.11.2013 в 14:09

Alex_ST

Дата: Четверг, 07.11.2013, 20:40 | Сообщение № 12

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3213

Репутация: 609 ±

Замечаний: 0% ±

2003

tati_2000, как раз всю книгу, оказывается, проще обработать, чем выделенный ограниченный диапазон.
Ну, что-то типа этого:[vba]

Код

Sub Replace_by_VAL_in_WB()   '  во всей книге заменить формулы на значения
     Dim rRng As Range, rAr As Range, WSh As Worksheet
     For Each WSh In Worksheets
         Set rRng = WSh.Cells.SpecialCells(xlCellTypeFormulas)
         If Not rRng Is Nothing Then
             For Each rAr In rRng.Areas: rAr.Value = rAr.Value: Next rAr
         End If
     Next WSh
End Sub

[/vba]

С уважением,
Алексей
MS Excel 2003 - the best!!!

Сообщение отредактировал Alex_ST - Четверг, 07.11.2013, 20:55

Ответить

Макрос "REPLACE_by_VAL" (Заменить формулы на значения)

Страница 1 из 1
1