чтение и разделение строки из ячейки

[DMITRIY_78]

Ребята Здравствуйте! у меня такой вопрос, отмечу сразу, понимаю что задача возможно не разрешима, НО вдруг найдется пытливый ум, что то предложить. А вопрос такой в примере во вложении, вызывая из столбца "адрес" в ячейку из формы заносятся адресные данные, Но хотелось бы , при активации ячейки с записью занести обратно в текстовые поля для редактирования и дальнейшей перезаписи.
Заранее спасибо всем!

[Aleksandr H.]

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

понимаю что задача возможно не разрешима

видел как-то подобную "магию"
https://youtu.be/Wis4U7Zcf4o

[Igor1961]

Для начала сделайте отдельные столбцы для области, города, района, дома, улицы и всего остального, после этого определитесь с видом конечного результата (город, обл. дом или в каком порядке еще захотите), а потом уже можно будет без проблем вытягивать данные в итоговый столбец, в форму и куда угодно. То, что у Вас сейчас - лишняя головная боль за свой счет. Можно исправить, но придется много условий прописывать, и не факт что все будет предусмотрено. Например, в файле у Вас: "Тамбвоский р-н" это точно "Тамбовский"?

[DMITRIY_78]

Igor1961, я вас понял, но с отдельными столбцами у меня есть такой макрос, но мне бы не хотелось бы "плодить" столбцы видимость документа и так мала, спасибо, обратите внимание на пост Aleksandr H. заинтриговал "сорванец",

[DMITRIY_78]

Aleksandr H., поделитесь макросом?

[Aleksandr H.]

Private Sub PrepareData(sInput As String)
'    Dim sInput As String
    Dim oblast As String
    Dim rajon As String
    Dim gorod As String
    Dim selo As String
    Dim ulica As String
    Dim dom As String
    Dim korpus As String
    Dim kvartyra As String
    Dim kod_padika As String
    Dim etag As String
    Dim stroenie As String
    Dim padik As String
    Dim ar() As String
    Dim txt As Variant
    Dim flag As Boolean
    sInput = " " & Trim(sInput)
    If Right(sInput, 1) = "," Then sInput = Left(sInput, Len(sInput) - 1)
    If sInput = "" Then Exit Sub
    ar = Split(sInput, ","): flag = True
    For Each txt In ar
       
        If InStr(txt, " Обл.") > 0 Then
            oblast = Trim(txt)
            ElseIf InStr(txt, " p-н.") > 0 Then
            rajon = Trim(txt)
            ElseIf InStr(txt, " г. ") > 0 Then
            gorod = Trim(txt)
            ElseIf InStr(txt, " с. ") > 0 Then
            selo = Trim(txt)
            ElseIf InStr(txt, " Ул. ") > 0 Then
            ulica = Trim(txt)
            ElseIf InStr(txt, " д. ") > 0 Then
            dom = Trim(txt)
            ElseIf InStr(txt, " Кор. ") > 0 Then
            korpus = Trim(txt)
            ElseIf InStr(txt, " Кв. ") > 0 Then
            kvartyra = Trim(txt)
            ElseIf InStr(txt, " Код_домоф. ") > 0 Then
            kod_padika = Trim(txt)
            ElseIf InStr(txt, " эт. ") > 0 Then
            etag = Trim(txt)
            ElseIf InStr(txt, " Стр. ") > 0 Then
            stroenie = Trim(txt)
            ElseIf InStr(txt, " под., ") > 0 Then
            padik = Trim(txt)
        Else
            flag = False
        End If
    Next txt
    If flag Then
        UserForm1.TextBox12 = Replace(oblast, " Обл.", "")
        UserForm1.TextBox1 = Replace(rajon, " p-н.", "")
        UserForm1.TextBox2 = Replace(gorod, "г. ", "")
        UserForm1.TextBox3 = Replace(selo, "с. ", "")
        UserForm1.TextBox4 = Replace(ulica, "Ул. ", "")
        UserForm1.TextBox5 = Replace(dom, "д. ", "")
        UserForm1.TextBox6 = Replace(korpus, "Кор. ", "")
        UserForm1.TextBox7 = Replace(kvartyra, "Кв. ", "")
        UserForm1.TextBox8 = Replace(kod_padika, "Код_домоф. ", "")
        UserForm1.TextBox9 = Replace(etag, "эт. ", "")
        UserForm1.TextBox11 = Replace(stroenie, "Стр. ", "")
        UserForm1.TextBox10 = Replace(padik, "под. ", "")
    Else
        MsgBox "Фигня на входе"
    End If
End Sub

Private Sub UserForm_Initialize()
    Debug.Print ActiveCell
    PrepareData ActiveCell
End Sub

[DMITRIY_78]

Aleksandr H., СУПЕР, РЕСПЕКТ