текст по строкам внести в одну ячейку

[user7789]

товарищи знатоки, помогите!!!

имеется текс, по столбцу A1:A10000, в каждой строке определенные символы, но так же есть пустые строки.

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

[SAS888]

В какую ячейку какой текст нужно "засунуть"?
"Три пустые строки" - это разделитель чего?

[user7789]

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

В какую ячейку какой текст нужно "засунуть"?
"Три пустые строки" - это разделитель чего?

исходный данные желаемый результат
_________________ _________________
ИВАНОВ | | ИВАНОВ |
________________ | | ИВАН |
ИВАН | | ИВАНОВИЧ |
________________ | | 1990 |
ИВАНОВИЧ | | МОСКВА |
________________ | |_________________|
|
1990 |
________________ |
МОСКВА |
________________ |
|
________________ |
|
________________ |
________________ |
и тд |
________________ |

[user7789]

2 SAS888
нажмите цитата, тогда формат будет понятен.

[SAS888]

Можно сделать по разному. Только, не ясно, где должны располагаться результаты?

[user7789]

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

Можно сделать по разному. Только, не ясно, где должны располагаться результаты?

можно в столбце B.

[SAS888]

Можно так:

Sub Main()
    Dim i As Long, j As Long, s As String
    i = 1: j = 1: k = 0: [B:B].WrapText = True: Application.ScreenUpdating = False
    Do
        If Cells(i, 1) = "" Then
            k = k + 1: i = i + 1
        Else
            For Each Cell In Cells(i, 1).CurrentRegion: s = s & Chr(10) & Cell: Next
            Cells(j, 2) = Right(s, Len(s) - 1): j = j + 1: k = 0: s = ""
            i = i + Cells(i, 1).CurrentRegion.Rows.Count
        End If
    Loop While k < 4
End Sub

Разделять блоки можно пустыми строками (до 3-х штук). Признак окончания - более трех пустых строк подряд.

[user7789]

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

Можно так:

Sub Main()
    Dim i As Long, j As Long, s As String
    i = 1: j = 1: k = 0: [B:B].WrapText = True: Application.ScreenUpdating = False
    Do
        If Cells(i, 1) = "" Then
            k = k + 1: i = i + 1
        Else
            For Each Cell In Cells(i, 1).CurrentRegion: s = s & Chr(10) & Cell: Next
            Cells(j, 2) = Right(s, Len(s) - 1): j = j + 1: k = 0: s = ""
            i = i + Cells(i, 1).CurrentRegion.Rows.Count
        End If
    Loop While k < 4
End Sub

Разделять блоки можно пустыми строками (до 3-х штук). Признак окончания - более трех пустых строк подряд.

после запуска, ошибку 400 выдает.

[SAS888]

Прикрепите файл.

[user7789]

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

Прикрепите файл.

буржуйский сервак блокирует.