Макрос с диалоговым окном. Возможно такое?

[Zhiltsov]

Касательно переноса данных. Задача следующая: необходим макрос при старте которого появлялось диалоговое окно в котором:
Поле 1:
выбор диапазона работы макроса
Поле2:
что ищем.
Поле три где вставляем.
Я вижу это так:
В поле 1 указываем например столбец "B", в поле 2 указываем "ул.", в поле 3 указываем ",".
Что делает макрос:
В выделенном диапазоне просматривает ячейки слева направо, если в начале ячейки находит "ул.", то переносит в место перед следующим символом ","
Например ул. Ленина, д1
Результат Ленинаул., д1

Господа помогите, а то необходимо ежедневно обрабатывать файл размером более 2000 строк с такой бедой, по полдня трачу на это дело, хотя подозреваю что можно сделать чтобы обрабатывалось гораздо быстрее.

[EducatedFool]

необходимо ежедневно обрабатывать файл размером более 2000 строк с такой бедой, по полдня трачу на это дело

С этого и надо было начинать разговор в предыдущей теме...
Я-то думал, тот файл - это единичный случай.

Можно сделать и без диалогового окна, если единственная его цель - выполнить обработку, описанную в этой теме.

Если будет время сегодня вечером - постараюсь сделать.

Если у Вас есть возможность разговаривать через Скайп - было бы очень неплохо (чтобы обсудить все нюансы обработки)

[Zhiltsov]

Skype к сожалению нет, работаю на режимном объекте доступ ко всему минимальный. Может повторюсь но суть такова, что мне присылают файл с адресами в одном из столбцов, мне необходимо подгрузить данный файл на сайт, и если ячейка начинается с "ул.", "б-р", "наб.", "пер." и тд. то отображается все некоректно. задача состоит в том, чтобы тип застройки (б-р, ул., наб, и тд.) если он стоит до названия шел после названия через пробел. Если типа застройки нет, то и не надо (потому как реализовать это даже не представляю как можно)
В предыдущей теме я в архив "Адреса" вкладывал Word файл с структурой которая должна быть.
Адреса которые нужно обработать прикреплены здесь.

[SAS888]

Посмотрите один из возможных вариантов во вложении. Запустите макрос "Main".

[EducatedFool]

Вот ещё один вариант:

Option Compare Text

Function ОбработатьТекст(ByVal txt As String) As String
    arr = Array("б-р ", "наб ", "пер ", "пл ", "пр-д ", "пр-т ", "тупик ", "ул ", "ст ", "пос ", "п ", "пгт ")
    txt = Replace(txt, ",", ", "): txt = Replace(txt, ".", ". ")
    txt = Application.WorksheetFunction.Trim(txt)
    For i = LBound(arr) To UBound(arr)
        st = arr(i)
        If txt Like st & "*" Or txt Like Trim(st) & "." & "*" Then
            txt = Mid(txt, InStr(1, txt, " ") + 1):
            rst = Split(txt, ",")(0):    'rst = Replace(rst, ",", "")
            st = Trim(st): If Right$(st, 1) <> "." And Len(st) < 5 Then st = st & "."
            txt = Replace(txt, rst, rst & " " & st): txt = Replace(txt, " ,", ",")
            Exit For
        End If
    Next i
    txt = Replace(txt, ". ", ".")
    If Right$(txt, 1) = "," Then txt = Mid(txt, 1, Len(txt) - 1)
    ОбработатьТекст = txt
End Function

Sub ОбработкаАдресов()
    Dim ra As Range, cell As Range: Set ra = Range([a2], Range("a65000").End(xlUp))
    Application.ScreenUpdating = False
    For Each cell In ra.Cells
        ' If Application.WorksheetFunction.Trim(cell) <> ОбработатьТекст(cell) Then
        cell.Next = ОбработатьТекст(cell)
    Next
End Sub

Sub Очистка(): [b:b].ClearContents: End Sub

При необходимости список переносимых значений иожно пополнить.

Пример во вложении: (нажмите зелёную кнопочку)

[Zhiltsov]

Спасибо огромное!!!
В варианте адреса2 почему то не все строки обрабатывает.

EducatedFool, а можно в варианте Адреса сделать так чтобы результат изменений заменял исходный вариант?

[EducatedFool]

можно в варианте Адреса сделать так чтобы результат изменений заменял исходный вариант?

Конечно можно.
Вывод в соседнюю ячейку я сделал лишь для удобства сравнения исходных и обработанных строк.

Замените в макросе ОбработкаАдресов строку cell.Next = ОбработатьТекст(cell)
на строку cell = ОбработатьТекст(cell)

[Zhiltsov]

Отлично!
А если у меня изменится столбец в котором будут адреса, мне достаточно изменить данные здесь: Range([a2], Range("a65000") ?

[EducatedFool]

Да.
Для столбца D это будет выглядеть так: Set ra = Range([d2], Range("d65000").End(xlUp))
(начиная с ячейки D2, и заканчивая последней заполненной ячейкой в столбце D)

Можете также указать любой другой диапазон:

Set ra = [a5:d258]

Или несколько:
Set ra = Range("a6, a8:a1200, a1205:a1209, b4:b664")

[Zhiltsov]

Все! Отлично работает!!!
Господа вы молодцы!
Браво вам!
Спасибо!