Заранее прошу прощения, за, возможно, нарушение правил по части 1 пост - 1 вопрос, просто не представляю, как разбить этот процесс на логические части.
Смысл в том, чтобы макрос склеил значения из указанной строки (7) со значениями из строки сверху (6) через пробел с вытиранием лишних пробелов (аналогично функции СЖПРОБЕЛЫ), и дропнул все лишние строки сверху, чтобы полученное значение встало в строку 1.
По файлу-примеру, в строке №1 должно появиться: А1 - Заголовок1 ... Е1 - Верхнеуровневый Заголовок5 ... Благодарю!
Заранее прошу прощения, за, возможно, нарушение правил по части 1 пост - 1 вопрос, просто не представляю, как разбить этот процесс на логические части.
Смысл в том, чтобы макрос склеил значения из указанной строки (7) со значениями из строки сверху (6) через пробел с вытиранием лишних пробелов (аналогично функции СЖПРОБЕЛЫ), и дропнул все лишние строки сверху, чтобы полученное значение встало в строку 1.
По файлу-примеру, в строке №1 должно появиться: А1 - Заголовок1 ... Е1 - Верхнеуровневый Заголовок5 ... Благодарю!ArkaIIIa
Sub tt() Application.ScreenUpdating = 0 Application.Calculation = xlCalculationManual c0_ = 1 If Cells(1, c0_) = "" Then r1_ = Cells(1, c0_).End(xlDown).Row Else r1_ = 2'если в первой строке что-то есть, то это будет верхнеуровневый заголовок End If c1_ = Cells(r1_, Columns.Count).End(xlToLeft).Column For i = c0_ To c1_ Cells(r1_, i) = WorksheetFunction.Trim(Cells(r1_ - 1, i) & " " & Cells(r1_, i)) Next i Cells(r1_, c0_).Resize(1, c1_ - c0_ + 1).WrapText = True'перенос текста в ячейках Cells(1, c0_).Resize(r1_ - r0_ - 1).EntireRow.Delete Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = 1 End Sub
[/vba]
Так нужно? [vba]
Код
Sub tt() Application.ScreenUpdating = 0 Application.Calculation = xlCalculationManual c0_ = 1 If Cells(1, c0_) = "" Then r1_ = Cells(1, c0_).End(xlDown).Row Else r1_ = 2'если в первой строке что-то есть, то это будет верхнеуровневый заголовок End If c1_ = Cells(r1_, Columns.Count).End(xlToLeft).Column For i = c0_ To c1_ Cells(r1_, i) = WorksheetFunction.Trim(Cells(r1_ - 1, i) & " " & Cells(r1_, i)) Next i Cells(r1_, c0_).Resize(1, c1_ - c0_ + 1).WrapText = True'перенос текста в ячейках Cells(1, c0_).Resize(r1_ - r0_ - 1).EntireRow.Delete Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = 1 End Sub