Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Замена текста макросом. - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Замена текста макросом. (Макросы/Sub)
Замена текста макросом.
AVI Дата: Четверг, 20.10.2016, 16:07 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 174
Репутация: 6 ±
Замечаний: 0% ±

Excel 2013
Добрый день!
Средствами записи макроса я записал вот такого монстра.
[vba]
Код
Sub Макрос5()
    Application.CutCopyMode = False
    Cells.Replace What:="ул., д.", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="пер., д.", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="мкр., д.", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="пр-кт., д.", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="бул., д.", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:=", кв.", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="просп., д.", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="комнаты", Replacement:="к.", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="комната", Replacement:="к.", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="комн", Replacement:="к.", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="ком", Replacement:="к.", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:=", к.", Replacement:="к.", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:=",к.", Replacement:="к.", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="  ", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub
[/vba]
Все бы ничего но, помогите, пожалуйста сделать так, что бы он работал только, например, по столбцу а.
И помогите заставить его выполнять такую функцию
Код
ПСТР(A2;1;(НАЙТИ(".";A2;1)-1))&ПОДСТАВИТЬ(ПСТР(A2;ПОИСК(".";A2);99);"-";"")

Смысл ее в том, что в первоначально в тексте она удаляет тире "-" после первой точки, а уж потом выполняется то, что описано выше.
К сообщению приложен файл: 5569214.xlsm(14Kb)
 
Ответить
СообщениеДобрый день!
Средствами записи макроса я записал вот такого монстра.
[vba]
Код
Sub Макрос5()
    Application.CutCopyMode = False
    Cells.Replace What:="ул., д.", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="пер., д.", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="мкр., д.", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="пр-кт., д.", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="бул., д.", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:=", кв.", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="просп., д.", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="комнаты", Replacement:="к.", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="комната", Replacement:="к.", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="комн", Replacement:="к.", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="ком", Replacement:="к.", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:=", к.", Replacement:="к.", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:=",к.", Replacement:="к.", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="  ", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub
[/vba]
Все бы ничего но, помогите, пожалуйста сделать так, что бы он работал только, например, по столбцу а.
И помогите заставить его выполнять такую функцию
Код
ПСТР(A2;1;(НАЙТИ(".";A2;1)-1))&ПОДСТАВИТЬ(ПСТР(A2;ПОИСК(".";A2);99);"-";"")

Смысл ее в том, что в первоначально в тексте она удаляет тире "-" после первой точки, а уж потом выполняется то, что описано выше.

Автор - AVI
Дата добавления - 20.10.2016 в 16:07
Karataev Дата: Четверг, 20.10.2016, 16:29 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 641
Репутация: 226 ±
Замечаний: 0% ±

Excel
Чтобы вести замену только в столбце "A" замените "Cells" на Columns("A"):
[vba]
Код
     Columns("A").Replace What:="ул., д.", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
[/vba]
Макрос для удаления дефисов:
[vba]
Код
Sub Удалить_дефисы()

    Dim arr(), lngInStr As Long, lr As Long, i As Long
    
    lr = Columns("A").Find(What:="*", LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Row
    arr() = Range("A1:A" & lr).Value
    
    For i = 2 To UBound(arr)
        lngInStr = InStr(arr(i, 1), ".")
        If lngInStr > 0 Then
            arr(i, 1) = Left(arr(i, 1), lngInStr - 1) & Replace(arr(i, 1), "-", "", lngInStr)
        Else
            arr(i, 1) = Replace(arr(i, 1), "-", "")
        End If
    Next
    
    Range("A1:A" & lr).Value = arr()
    
End Sub
[/vba]




Сообщение отредактировал Karataev - Четверг, 20.10.2016, 16:30
 
Ответить
СообщениеЧтобы вести замену только в столбце "A" замените "Cells" на Columns("A"):
[vba]
Код
     Columns("A").Replace What:="ул., д.", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
[/vba]
Макрос для удаления дефисов:
[vba]
Код
Sub Удалить_дефисы()

    Dim arr(), lngInStr As Long, lr As Long, i As Long
    
    lr = Columns("A").Find(What:="*", LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Row
    arr() = Range("A1:A" & lr).Value
    
    For i = 2 To UBound(arr)
        lngInStr = InStr(arr(i, 1), ".")
        If lngInStr > 0 Then
            arr(i, 1) = Left(arr(i, 1), lngInStr - 1) & Replace(arr(i, 1), "-", "", lngInStr)
        Else
            arr(i, 1) = Replace(arr(i, 1), "-", "")
        End If
    Next
    
    Range("A1:A" & lr).Value = arr()
    
End Sub
[/vba]

Автор - Karataev
Дата добавления - 20.10.2016 в 16:29
AVI Дата: Четверг, 20.10.2016, 16:44 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 174
Репутация: 6 ±
Замечаний: 0% ±

Excel 2013
Karataev, Спасибо!
Блин, если чистить, так скажем, 300 000 строк, то ой чет тяжело экселю становится. Видимо потому, что макрос на каждый запрос пробегает эти строки снова и снова.
Думал, что получится облегчить файл. Так получилось наоборот...


Сообщение отредактировал AVI - Четверг, 20.10.2016, 16:51
 
Ответить
СообщениеKarataev, Спасибо!
Блин, если чистить, так скажем, 300 000 строк, то ой чет тяжело экселю становится. Видимо потому, что макрос на каждый запрос пробегает эти строки снова и снова.
Думал, что получится облегчить файл. Так получилось наоборот...

Автор - AVI
Дата добавления - 20.10.2016 в 16:44
Karataev Дата: Четверг, 20.10.2016, 16:52 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 641
Репутация: 226 ±
Замечаний: 0% ±

Excel
Не понял, что тормозит работу Вашего макроса: мой макрос "Удалить_дефисы" из поста 2 или то, что теперь замена стала только в столбце "A"?
Макрос "Удалить_дефисы" полностью оптимизирован, даже не знаю, что в нем можно заменить, чтобы ускорить работу, вроде все оптимизировано.

Можно добавить в макрос эти две строки:
[vba]
Код
    Application.ScreenUpdating = False
    'функциональный код
    Application.ScreenUpdating = True
[/vba]
Вашу замену (с использованием "Replace") должен по идее ускорить. Макрос "Удалить_дефисы" вряд ли ускорит, т.к. этот макрос только один раз вставляет данные на лист.




Сообщение отредактировал Karataev - Четверг, 20.10.2016, 16:55
 
Ответить
СообщениеНе понял, что тормозит работу Вашего макроса: мой макрос "Удалить_дефисы" из поста 2 или то, что теперь замена стала только в столбце "A"?
Макрос "Удалить_дефисы" полностью оптимизирован, даже не знаю, что в нем можно заменить, чтобы ускорить работу, вроде все оптимизировано.

Можно добавить в макрос эти две строки:
[vba]
Код
    Application.ScreenUpdating = False
    'функциональный код
    Application.ScreenUpdating = True
[/vba]
Вашу замену (с использованием "Replace") должен по идее ускорить. Макрос "Удалить_дефисы" вряд ли ускорит, т.к. этот макрос только один раз вставляет данные на лист.

Автор - Karataev
Дата добавления - 20.10.2016 в 16:52
AVI Дата: Четверг, 20.10.2016, 17:07 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 174
Репутация: 6 ±
Замечаний: 0% ±

Excel 2013
Karataev, Простите, я, может, не правильно выразился. Ваш макрос по замене дефиса полностью решил вопрос!
Я написал про свое "детище". Что оно проезжает по всем ячейкам столбца А столько раз, сколько замен нужно произвести. И именно это тормозит его работу.
 
Ответить
СообщениеKarataev, Простите, я, может, не правильно выразился. Ваш макрос по замене дефиса полностью решил вопрос!
Я написал про свое "детище". Что оно проезжает по всем ячейкам столбца А столько раз, сколько замен нужно произвести. И именно это тормозит его работу.

Автор - AVI
Дата добавления - 20.10.2016 в 17:07
AVI Дата: Четверг, 20.10.2016, 17:09 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 174
Репутация: 6 ±
Замечаний: 0% ±

Excel 2013
Можно добавить в макрос эти две строки:
    Application.ScreenUpdating = False
    'функциональный код
    Application.ScreenUpdating = True

Спасибо, действительно помогло!
 
Ответить
Сообщение
Можно добавить в макрос эти две строки:
    Application.ScreenUpdating = False
    'функциональный код
    Application.ScreenUpdating = True

Спасибо, действительно помогло!

Автор - AVI
Дата добавления - 20.10.2016 в 17:09
Karataev Дата: Четверг, 20.10.2016, 17:13 | Сообщение № 7
Группа: Проверенные
Ранг: Ветеран
Сообщений: 641
Репутация: 226 ±
Замечаний: 0% ±

Excel
AVI, решилась Ваша проблема? Больше не тормозит?


 
Ответить
СообщениеAVI, решилась Ваша проблема? Больше не тормозит?

Автор - Karataev
Дата добавления - 20.10.2016 в 17:13
AVI Дата: Четверг, 20.10.2016, 17:21 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 174
Репутация: 6 ±
Замечаний: 0% ±

Excel 2013
решилась Ваша проблема? Больше не тормозит?

Да, спасибо, срабатывает значительно быстрее!
 
Ответить
Сообщение
решилась Ваша проблема? Больше не тормозит?

Да, спасибо, срабатывает значительно быстрее!

Автор - AVI
Дата добавления - 20.10.2016 в 17:21
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Замена текста макросом. (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!