Объединение ячеек в строке

[slon_slon]

Добрый день!

К сожалению я очень далек от программирования, а в помощи нуждаюсь...

Имеется таблица из 18 тысяч строк(Word).

Мне надо преобразовать ее в человеческий вид, т.к. она разбита на большое количество строк, и текст теряет и-за этого форматирование и смысл.

Для этого, необходимо в выделенной строке в каждом из столбцов этой строки объединить все строки(вместе с текстом).

Также было бы очень желательно, чтобы при этом текст из объединяемых ячеек разделялся не переносом строки(как получается после команды "объединить строки"), а просто пробелом...

МНЕ ОЧЕНЬ НУЖНА ВАША ПОМОЩЬ!!!

Заранее спасибо!

[viter.alex]

Приложите файл с примером того, что есть и что нужно получить. Задание выполнимо, сразу скажу. Но нужно точно понимать, что вы хотите получить в результате.

[slon_slon]

Прикладываю файл с примером таблички.
Необходимо чтобы все остальные строки таблицы (4,5 и т.д.) выглядели как строки 1,2,3.

Заранее спасибо!

П.С. крайне нуждаюсь в помощи!!!

[viter.alex]

Вот такой макрос. Строки для объединения определяются как пустые строки в первом столбце. Абзацы заменяются на пробелы, а строка подгоняется по высоте под текст.
Чтобы макрос начал работать курсор должен находится в любой ячейке требуемой таблицы. Ячейку выделять не нужно — просто поставить курсор.
Не знаю сколько будет обрабатывать 18000 строк, но у меня 1500 строк сделало за 20 мин. Может кто-нибудь оптимизирует?

Sub MergeRowsByColumns()
  Dim oTbl As Table, iStart As Long, iEnd As Long, i#, j#, k#, iRowsCnt
  Set oTbl = Selection.Tables(1)
  iRowsCnt = oTbl.Rows.Count
  Application.ScreenUpdating = False
  Do:i = i + 1
    'Ищем пустую ячейку в первом столбце. Запоминаем номер предыдущей строки
    If Len(oTbl.Cell(i + 1, 1).Range.Text) <= 2 Then
      iStart = oTbl.Cell(i, 1).RowIndex
      'Начиная с этой строки ищем заполненную ячейку в первом столбце и также запоминаем номер _
      предыдущей строки
      For j = iStart + 1 To iRowsCnt
        If Len(oTbl.Cell(j, 1).Range.Text) > 2 Or j = iRowsCnt Then
          iEnd = IIf(j = iRowsCnt, j, oTbl.Cell(j, 1).Previous.RowIndex)
          For k = 1 To oTbl.Columns.Count
            'Объединяем все строки по столбцам
            ActiveDocument.Range(oTbl.Cell(iStart, k).Range.Start, oTbl.Cell(iEnd, k).Range.End).Select
            Selection.Cells.Merge
            'Заменяем знак абзаца на пробел
            Selection.Find.Execute findtext:="^0013", replacewith:="^0032", Replace:=wdReplaceAll
          Next k
          oTbl.Rows(i).Height = 24 'уменьшаем высоту строки по высоте текста
          'пересчитываем количество строк после объединения
          iRowsCnt = iRowsCnt - (iEnd - iStart)
          Exit For
        End If
      Next j
    End If
  Loop While i <> iRowsCnt
  Application.ScreenUpdating = True
End Sub

Вот ваш файл с результатом работы макроса Вложение 9546. Ну и сам макрос тоже в нем находится в модуле ThisDocument

[slon_slon]

ООО!!!!!
СПАСИБО ВАМ НЕЧЕЛОВЕЧЕСКОЕ!!!!

Я практически испытал оргазм после обеда (оставил работать на обед ~час и десять минут) - пришел а табличка в божеском виде!!!!!!!
СПАСИБО!!!!

[viter.alex]

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

ООО!!!!!
СПАСИБО ВАМ НЕЧЕЛОВЕЧЕСКОЕ!!!!

Я практически испытал оргазм после обеда (оставил работать на обед ~час и десять минут) - пришел а табличка в божеском виде!!!!!!!
СПАСИБО!!!!

Вот еще одним счастливым на Земле больше!

[slon_slon]

ОГРОМНОЕ СПАСИБО!!! ФРОНТ РАБОТ СОКРАТИЛСЯ РАЗ в ***ДЦАТЬ!!!!

Как добавить плюсы в репу???? )