разбить адрес по столбцам

[evdss]

В одном столбце имеются адреса. надо разбить адрес по столбцам макросом
670024 г.Улан-Удэ,ул Чертенкова 127 п кв 8
670009 г.Улан-Удэ,п Зеленый д 1 кв 45
670034 г.Улан-Удэ,пр 50 лет Октября 4 кв 27
670024 г.Улан-Удэ,ул Революции 1905 года 104 а кв 88
670045 г.Улан-Удэ,пер Агрономический 3 кв 1
надо получить по столбцам
первый второй третий четвертый пятый шестой седьмой восьм
670024 г. Улан-Удэ ул Чертенкова 127 кв 8
Проблема, название улицы может быть из нескольких слов, может это быть ул или пер, номер дома с буквами и без.

[vikttur]

Попробуйте инструмент Текст_по_столбцам (меню Данные). За несколько проходов - отделить первые столбцы (фиксированная ширина)...

[evdss]

так и делаю, но файлов много и поэтому много ручной работы, как бы автоматизировать этот процесс

[EducatedFool]

Попробуйте такой макрос:




Безусловно, макрос требует множества доработок.
В общем случае, добиться 100%-го разделения адресов невозможно - это задача для искусственного интеллекта.

Вот весь код:

Sub test()
    Dim cell As Range, ra As Range: Application.ScreenUpdating = False
    Set ra = Range([A2], Range("A" & Rows.Count).End(IIf(Len(Range("A" & Rows.Count)), xlDown, xlUp)))
    For Each cell In ra.Cells
        cell.Next.Resize(, 5) = РезультатыОбработки(cell)
    Next cell
    [b:f].EntireColumn.AutoFit
End Sub

Function РезультатыОбработки(ByVal txt As String)
    Индекс = Split(Trim(txt), " ")(0)
    txt = Trim(Mid(txt, Len(Индекс) + 1))
    
    Город = Split(Trim(txt), ",")(0)
    ОстатокАдреса = Trim(Mid(txt, Len(Город) + 1))
    If Город Like "г.*" Then Город = Trim(Mid(Город, 3))

    Улица = Split(Trim(ОстатокАдреса), " ")(0) & " " & Split(Trim(ОстатокАдреса), " ")(1)
    Улица = Replace(Улица, ",", ""): Улица = Replace(Улица, "ул ", "ул.")

    НачалоАдреса = Split(Trim(txt), " кв ")(0)
    Дом = Split(Trim(НачалоАдреса), " ")(UBound(Split(Trim(НачалоАдреса), " ")))
    If Not IsNumeric(Дом) Then Дом = Split(Trim(НачалоАдреса), " ")(UBound(Split(Trim(НачалоАдреса), " ")) - 1) & Дом

    If txt Like "* кв *" Then Квартира = Split(Trim(txt), " ")(UBound(Split(Trim(txt), " ")))

    РезультатыОбработки = Array(Индекс, Город, Улица, Дом, Квартира)
End Function

PS: Функцию РезультатыОбработки можно использовать и на листе - без запуска макросов:

  Ячейка: B2      Формула массива  (стиль A1):   =РезультатыОбработки(A2)
                  Формула массива  (стиль R1C1): =РезультатыОбработки(RC[-1])

Внимание: ввод формул массива завершается нажатием CTRL+SHIFT+ENTER вместо ENTER

Пример в файле:

[evdss]

спасибо большое. попробую с улицами доработать

[evdss]

конечно может мне подсчитать количество пробелов в зависимости от этого количество слов в названии улицы?

[EducatedFool]

может мне подсчитать количество пробелов в зависимости от этого количество слов в названии улицы?

не поможет. нужен гораздо более сложный анализ.

PS: если б это было так просто - я сразу бы реализовал это в макросе.
К примеру, номер дома может записан как "2", "2а", "2 а" или вообще не указан.
И к чему тут эти подсчёты слов?

[evdss]

Улицы пока видимо придется вручную подгонять

[EducatedFool]

Сообщение от evdss

Улицы пока видимо придется вручную подгонять

Могу всё это автоматизировать - но не бесплатно (работы много)
Макрос будет корректно разбивать адрес на составляющие в 95-99% случаев.

PS: есть много адресов, которые вообще непонятно как надо разбивать, например:

670009 г.Улан-Удэ,пер Невского 4 корп а 3 ком 4,5
670002 г.Улан-Удэ,ул Выборгская 17 общ
670002 г.Улан-Удэ,ул Октябрьская 21 корп с/с кв 23
670045 г.Улан-Удэ,ул Богданова 1/2
670002 г.Улан-Удэ,Бурятия Респ Улан-Удэ г,ул Октябрьская 20 а кв 22

[kagen]

Подскажите, пожалуйста, а как можно разбить один столбец текста на 2. Первый столбец должен быть максимум 35 символов (но без разрыва слов), а во втором должно быть все остальное.