Замена текста макросом.

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

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

Замена текста макросом. (Макросы/Sub)

AVI

Дата: Четверг, 20.10.2016, 16:07 | Сообщение № 1

Группа: Проверенные

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

Сообщений: 523

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

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

Excel 2016

Добрый день!
Средствами записи макроса я записал вот такого монстра.
[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);"-";"")

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

Добрый день!
Средствами записи макроса я записал вот такого монстра.
[vba]

Код

ПСТР(A2;1;(НАЙТИ(".";A2;1)-1))&ПОДСТАВИТЬ(ПСТР(A2;ПОИСК(".";A2);99);"-";"")

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

К сообщению приложен файл: 5569214.xlsm (14.4 Kb)

Ответить

СообщениеДобрый день!
Средствами записи макроса я записал вот такого монстра.
[vba]

Код

ПСТР(A2;1;(НАЙТИ(".";A2;1)-1))&ПОДСТАВИТЬ(ПСТР(A2;ПОИСК(".";A2);99);"-";"")

Автор - AVI
Дата добавления - 20.10.2016 в 16:07

Karataev

Дата: Четверг, 20.10.2016, 16:29 | Сообщение № 2

Группа: Проверенные

Ранг: Старожил

Сообщений: 1334

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

Замечаний: 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

Ответить

AVI

Дата: Четверг, 20.10.2016, 16:44 | Сообщение № 3

Группа: Проверенные

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

Сообщений: 523

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

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

Excel 2016

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

Сообщение отредактировал AVI - Четверг, 20.10.2016, 16:51

Ответить

Karataev

Дата: Четверг, 20.10.2016, 16:52 | Сообщение № 4

Группа: Проверенные

Ранг: Старожил

Сообщений: 1334

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

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

Excel

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

Можно добавить в макрос эти две строки:
[vba]

Код

    Application.ScreenUpdating = False
    'функциональный код
    Application.ScreenUpdating = True

[/vba]
Вашу замену (с использованием "Replace") должен по идее ускорить. Макрос "Удалить_дефисы" вряд ли ускорит, т.к. этот макрос только один раз вставляет данные на лист.

Сообщение отредактировал Karataev - Четверг, 20.10.2016, 16:55

Ответить

AVI

Дата: Четверг, 20.10.2016, 17:07 | Сообщение № 5

Группа: Проверенные

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

Сообщений: 523

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

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

Excel 2016

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