Новости:

Новая редакция правил форума: 2.4. Если вопрос или ответ содержится во вложенном файле, все-равно кратко описывайте в сообщении вопрос или суть решения. Это необходимо, чтобы тему можно было найти через поиск.

Главное меню

Макрос автозамены в книге

Автор Димычч, 17.10.2014, 10:23

« назад - далее »

Димычч

Здравствуйте.
В связи с нерешённой проблемой поломки ссылок на внешние файлы https://forum.msexcel.ru/index.php/topic,10346.msg51937.html#msg51937
создал простой макрос для быстрой замены сломанных ссылок на правильные:
Sub PUBORG()
' PUBORG Макрос
    Cells.Replace What:="\\sib.com\ORG\DFE", Replacement:= _
        "\\sib.com\pub\ORG\DFE", LookAt:=xlPart, SearchOrder:=xlByRows, _
        MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub


Прошу помочь добавить в макрос функции:
1. Замену производить не на текущем листе, а во всей книге (почему-то макрорекордер не реагировал на включение соответствующей опции).
2. По окончании замены выводить сообщение с кнопкой ОК или просто крестиком.

cheshiki1

#1
проверяйте. писал сразу на форум так что мало что. :)
Sub PUBORG()
    Application.ScreenUpdating = False
For i = 1 To Sheets.Count 'цикл по всем листам книги
    Sheets(i).Activate 'активируем лист
    Cells.Replace What:="\\sib.com\ORG\DFE", Replacement:= _
        "\\sib.com\pub\ORG\DFE", LookAt:=xlPart, SearchOrder:=xlByRows, _
        MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next
msgbox "Готово" 'выводим сообщение
Application.ScreenUpdating = True
End Sub

Димычч

Работает!
Но в конце операции после нажатия на кнопку всегда открывается последний лист. Нужно оставаться там, где был в момент запуска макроса.

vikttur

Записать в переменную имя листа, после отработки кода активировать лист.

Димычч

Цитата: vikttur от 17.10.2014, 12:46
Записать в переменную имя листа, после отработки кода активировать лист.
Смысл понятен, но как это выглядит в макросе? :)

_Boroda_

Например, так:
Sub tt()
    sn_ = ActiveSheet.Index
    'Код макроса
    Sheets(sn_).Select
End Sub
Скажи мне, кудесник, любимец ба'гов...



Яндекс-деньги: 41001632713405
Webmoney: R289877159277; Z102172301748; E177867141995

Димычч

Благодарю! Всё работает как часы!

RAN

#7
А может ну ее, эту активацию?  ;)
Sub qq()
Dim sh As Worksheet
    For Each sh In ThisWorkbook.Worksheets
        sh.Cells.Replace What:="a", Replacement:= _
                       "b", LookAt:=xlPart, SearchOrder:=xlByRows, _
                       MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Next
End Sub


Димычч

#8
Добрый день.
Последний макрос почему-то не работает.
Подскажите, как прикрутить счётчик к макросу замены, если там выполняется несколько разных замен? нужно чтобы в конце процесса выходило окошко "Выполнено ** замен".
Sub PUBORG()
sn_ = ActiveSheet.Index
    Application.ScreenUpdating = False
For i = 1 To Sheets.Count 'цикл по всем листам книги
    Sheets(i).Activate 'активируем лист
    Cells.Replace What:="\\sib.com\ORG\DFE", Replacement:= _
        "\\sib.com\pub\ORG\DFE", LookAt:=xlPart, SearchOrder:=xlByRows, _
        MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next
For i = 1 To Sheets.Count 'цикл по всем листам книги
    Sheets(i).Activate 'активируем лист
Cells.Replace What:="\\sib.com\pub\DFE", Replacement:= _
        "\\sib.com\pub\ORG\DFE", LookAt:=xlPart, SearchOrder:=xlByRows, _
        MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next
For i = 1 To Sheets.Count 'цикл по всем листам книги
    Sheets(i).Activate 'активируем лист
Cells.Replace What:="\\sib.com\DFE", Replacement:= _
        "\\sib.com\pub\ORG\DFE", LookAt:=xlPart, SearchOrder:=xlByRows, _
        MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next
MsgBox "Готово" 'выводим сообщение
Application.ScreenUpdating = True
Sheets(sn_).Select
End Sub


cheshiki1

Димычч зачем у вас три раза один и тот же цикл?

Димычч

Не один и тот же, искомые данные для замены - разные. Это неразгаданный косяк Экселя. Ломаются ссылки особым извращённым способом. Я уже создавал тему. Вопрос остался без решения.

cheshiki1

упс. не заметил. :) Тогда записывать нужно так.
Sub PUBORG()
sn_ = ActiveSheet.Index
    Application.ScreenUpdating = False
For i = 1 To Sheets.Count 'цикл по всем листам книги
    Sheets(i).Activate 'активируем лист
    Cells.Replace What:="\\sib.com\ORG\DFE", Replacement:= _
        "\\sib.com\pub\ORG\DFE", LookAt:=xlPart, SearchOrder:=xlByRows, _
        MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
  Cells.Replace "\\sib.com\pub\DFE", "\\sib.com\pub\ORG\DFE"
  Cells.Replace "\\sib.com\DFE", "\\sib.com\pub\ORG\DFE"
Next
MsgBox "Готово" 'выводим сообщение
Application.ScreenUpdating = True
Sheets(sn_).Select
End Sub

на счет счетчика моих знаний маловато. пока на мысли приходит только пройтись с помощью FINd да сложить все что найдет.

RAN

Димычч, похоже вы мой ответ не смотрели... Или, не в коня корм?
Рискну еще раз
Sub PUBORG()
    Application.ScreenUpdating = False
    For i = 1 To Sheets.Count    'цикл по всем листам книги
        With Sheets(i)
            .Cells.Replace What:="\\sib.com\ORG\DFE", Replacement:= _
                           "\\sib.com\pub\ORG\DFE", LookAt:=xlPart, SearchOrder:=xlByRows, _
                           MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            .Cells.Replace What:="\\sib.com\pub\DFE", Replacement:= _
                           "\\sib.com\pub\ORG\DFE", LookAt:=xlPart, SearchOrder:=xlByRows, _
                           MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            .Cells.Replace What:="\\sib.com\DFE", Replacement:= _
                           "\\sib.com\pub\ORG\DFE", LookAt:=xlPart, SearchOrder:=xlByRows, _
                           MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        End With
    Next
    MsgBox "Готово"    'выводим сообщение
    Application.ScreenUpdating = True
End Sub


Димычч

Спасибо! 
RAN, я видел ваш предпоследний макрос, который с одним условием, но он в том виде почему-то не сработал.
Просто не всегду получается оперативно отвечать... Последний работает чётко. 
Вариант cheshiki1 тоже работает :) Единственная разница, последний макрос полностью работает в "фоновом" режиме, а у
cheshiki1 - немного подёргивается экран, когда перебираются листы.

RAN

Цитата: Димычч от 19.12.2014, 05:06
но он в том виде почему-то не сработал.
У вас на листе была хоть одна ячейка с буквой "a"?
Или вы пытались подставиь в макрос вместо "a" свое значение?
"нет" и "нет" ?  ;)