Страницы: 1
RSS
Пронумеровать список с разделителем ";" (точка с запятой)
 
Добрый день, подскажите как пронумеровать список в ячейке разделенный ; (точка запятой)

Пример (как есть): Приготовление постели из раствора или частичное выравнивание готового гравийного (песчаного) основания; Установка фундаментных блоков (плит); Выверка правильности установки блоков (плит); Заделка швов раствором между блоком ленточных и составных фундаментов

На выходе (как хочу): 1. Приготовление постели из раствора или частичное выравнивание готового гравийного (песчаного) основания; 2. Установка фундаментных блоков (плит); 4. Выверка правильности установки блоков (плит); 5. Заделка швов раствором между блоком ленточных и составных фундаментов
Изменено: diman116 - 14.01.2021 19:10:12
 
Цитата
diman116 написал:
Пример (как есть):
Где есть?
 
Цитата
alexleoix написал:
Где есть?
 
Power Query
 
Цитата
alexleoix написал:
Power Query
а формулой  можно? пока Power Query тяжко дается
 
diman116, вариант макросом
Код
Sub mrshkei()
Dim arr, i As Long, lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lr
    arr = Split(Cells(i, 1), ";")
    For n = LBound(arr) To UBound(arr)
    x = UBound(arr) + 1
        t = t & " " & n + 1 & ". " & arr(n)
    Next n
    Cells(i, 2) = t
    t = Empty
Next i
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
Цитата
Mershik написал:
ариант макросом
Спасибо большое, работает. но можете подсказать один момент - чтоб в конце предложения была точка перед нумерацией. Прошу прощения что сразу не написал- увидел после результата
 
Код
Sub mrshkei()
Dim arr, i As Long, lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lr
    arr = Split(Cells(i, 1), ";")
    For n = LBound(arr) To UBound(arr)
    x = UBound(arr) + 1
        t = t & " " & n + 1 & ". " & arr(n)
    Next n
    Cells(i, 2) = t & "."
    t = Empty
Next i
End Sub
Изменено: Mershik - 14.01.2021 20:01:15
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, а зачем тут строка x = UBound(arr) + 1 во всех версиях кода?  )
Изменено: New - 14.01.2021 20:03:23
 
New, а фиг его знает ) что-то в процессе думал удалил, а кусок остался))
Код
Sub mrshkei()
Dim arr, i As Long, lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lr
    arr = Split(Cells(i, 1), ";")
    For n = LBound(arr) To UBound(arr)
        t = t & " " & n + 1 & ". " & arr(n)
    Next n
    Cells(i, 2) = t & ".": t = Empty
Next i
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
добавил в твой код Application.Trim, может так лучше будет ТС
Код
Sub mrshkei()
    Dim arr, i As Long, lr As Long, n As Long, t As String
    
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lr
        arr = Split(Cells(i, 1), ";")
        For n = LBound(arr) To UBound(arr)
            t = t & ". " & n + 1 & ". " & arr(n)
        Next n
        Cells(i, 2) = Application.Trim(Mid(t, 2, Len(t))) & ". "
        t = Empty
    Next i
End Sub
 
Цитата
Mershik написал:
Код
Отлично, спасибо большое
Страницы: 1
Наверх