1

Тема: Замена текста на таблицу

Уважаемые господа профессионалы, столкнулся с такой проблемой, есть таблица в таком виде, как ее можно переделать в обычную таблицу?
Буду признателен за любые ответы или идеи)

------------------------------------------------------------------
|              Найменування посади               |Кількість посад|
|------------------------------------------------+---------------|
|Помічник Голови Державної митної служби України |       1       |
|з питань взаємодії з правоохоронними органами   |               |
|------------------------------------------------+---------------|
|Помічник начальника управління організації      |       1       |
|боротьби з контрабандою та порушеннями митних   |               |
|правил Державної митної служби України          |               |
|------------------------------------------------+---------------|
|Помічник начальника підрозділу боротьби з       |       2       |
|контрабандою та порушеннями митних правил       |               |
|регіональної митниці                            |               |
------------------------------------------------------------------

2

Re: Замена текста на таблицу

Открываете, выделяете. Меню Таблица→Преобразовать→Текст в таблицу…
Появится окно, где нужно выставить такие параметры:
Замена текста на таблицу
После этого у получившейся таблицы удалить первый и последний столбцы, а также строки, не несущие информации. Таблица примет вид:
Замена текста на таблицу
Удалить лишние пробелы и объединить нужные ячейки. Всё.

Лучше день потерять — потом за пять минут долететь!

3

Re: Замена текста на таблицу

Большое спасибо за ответ! Но у меня что то не очень получается, при выборе 4 столбцов число строк 4, или я что то не правильно делаю?
Но все равно хотелось бы максимально все автоматизировать, макросом нельзя никак?

4

Re: Замена текста на таблицу

Скорее всего, неправильно выделяете. Число строк у Вас должно быть не активно, если вы правильно выбрали диапазон для преобразования в таблицу.

Лучше день потерять — потом за пять минут долететь!

5

Re: Замена текста на таблицу

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

6

Re: Замена текста на таблицу

Попробуйте записать действия с помощью макрорекордера, а потом пошагово их выполнять. Я так в свое время, лет семь или десять назад делал, когда нужно было переводить спецификации и перечни элементов, сделанные в лексиконе, в формат ворда. И еще, вроде где-то были уже готовые пакеты макросов, которые обрабатывали досовский текст. Не помню, правда, были ли там таблицы, нарисованные псевдографикой. Насколько я помню, в макросе я заменял горизонтальные полосы и на пробелы, кресты на вертикальные полосы и вертикальные полосы использовал как разделители, как и показано на рисунке выше

7

Re: Замена текста на таблицу

Запись макроса мало что прояснит. Преобразователи псевдографики действительно были и до сих пор используются.
Я вот посидел часок и набросал макрос, который будет работать с таблицей, приведённой в примере. Может алгоритм перебора ячеек для объединения не совсем удачный, но, на ночь глядя, в голову ничего умнее не пришло.

Sub ConvertTextToTable()
  Dim oTbl As Table 'Переменная для таблицы
  Dim i As Long 'Счётчик
  Application.ScreenUpdating = False 'Отключаем прорисовку экрана, чтобы не мерцал
  With Selection
    .ConvertToTable "|" 'Конвертируем в таблицу
    If .Tables.Count <> 1 Then 'Если в выделении нет таблицы, значит не получилось:(
      MsgBox "Преобразование текста в таблицу не удалось. Попробуйте ещё раз", vbCritical + vbOKOnly, "Преобразование"
      Exit Sub
    End If
    Set oTbl = .Tables(1) 'Запоминаем преобразованную таблицу
  End With
  
  oTbl.Columns.Last.Delete 'Удаляем последний столбец
  oTbl.Columns.First.Delete 'Удаляем первый столбец
  'Перебираем все строки, начиная снизу
  For i = oTbl.Rows.Count To 1 Step -1
    'Если ячейка данной строки в последнем столбце пустая, _
    т.е. содержит только конец абзаца и конец ячейки
    If oTbl.Columns.Last.Cells(i).Range.Text = ChrW(13) & ChrW(7) Then
      oTbl.Rows(i).Delete 'то эту строку удаляем.
    End If
  Next
  'Удаляем лишние пробелы
  oTbl.Range.Find.Execute "  {2;}", MatchWildcards:=True, ReplaceWith:="", Replace:=wdReplaceAll
  'Переводим курсор в первую ячейку последнего столбца
  oTbl.Columns.Last.Cells(1).Range.Select

  With Selection 'Курсор находится в последнем столбце
    .MoveDown
    Do 'Начинаем поиск ячеек для объединения
      'Если в выделении одна ячейка, то расширяем выделение вниз
      If .Information(wdStartOfRangeRowNumber) = .Information(wdEndOfRangeRowNumber) Then .MoveDown Extend:=wdExtend
      If .Cells(.Cells.Count).Range.Text = ChrW(13) & ChrW(7) Then 'Если ячейка пустая
        If .Cells(.Cells.Count).RowIndex <> oTbl.Rows.Count Then 'Если это не последняя ячейка в строке
          .MoveDown Extend:=wdExtend 'Расширяем выделение вниз
        Else
          If .Cells.Count > 1 Then 'Если в выделении более 1 ячейки
            'Создаём вспомогательную закладку, которую помещаем выделенные ячейки
            ActiveDocument.Bookmarks.Add "cells", Selection.Range
            'Объединяем соответствующие ячейки первого столбца
            oTbl.Columns.First.Cells(.Information(wdStartOfRangeRowNumber)).Merge oTbl.Columns.First.Cells(.Information(wdEndOfRangeRowNumber))
            'Выделяем ячейки в последнем столбце
            ActiveDocument.Bookmarks("cells").Range.Select
            'Объединяем ячейки
            .Cells.Merge
          End If
          'Переходим вниз
          .MoveDown
        End If
      Else 'Если ячейка не пустая, т.е. в ней есть номер
        .MoveUp Extend:=wdExtend 'Переходим вверх
        If .Cells.Count > 1 Then 'Если в выделении более 1 ячейки
          'Создаём вспомогательную закладку, которую помещаем выделенные ячейки
          ActiveDocument.Bookmarks.Add "cells", Selection.Range
          'Объединяем соответствующие ячейки первого столбца
          oTbl.Columns.First.Cells(.Information(wdStartOfRangeRowNumber)).Merge oTbl.Columns.First.Cells(.Information(wdEndOfRangeRowNumber))
          'Выделяем ячейки в последнем столбце
          ActiveDocument.Bookmarks("cells").Range.Select
          'Объединяем ячейки в последнем столбце
         .Cells.Merge
        End If
        'Переходим вниз
        .MoveDown
      End If
    Loop While .Information(wdWithInTable) 'Продолжаем цикл, пока курсор находится в таблице
  End With

  'Удаляем лишние абзацы
  oTbl.Range.Find.Execute "^p", ReplaceWith:=" ", Replace:=wdReplaceAll
  'Удаляем лишние пробелы
  oTbl.Range.Find.Execute "  {2;}", MatchWildcards:=True, ReplaceWith:="", Replace:=wdReplaceAll
  'Удаляем вспомогательную закладку
  ActiveDocument.Bookmarks("cells").Delete
  Application.ScreenUpdating = True 'Включаем прорисовку экрана
End Sub
Лучше день потерять — потом за пять минут долететь!

8

Re: Замена текста на таблицу

Да для таблицы наведенной в примере подходит но таблички бывают разные как с этим быть... И о каких преобразователях псевдографики идет речь?

9

Re: Замена текста на таблицу

Вот об этих

Лучше день потерять — потом за пять минут долететь!

10

Re: Замена текста на таблицу

big_smile  спасибо я бы сам и не додул, просто хотелось знать мнение профи...

11

Re: Замена текста на таблицу

И еще раз доброго дня, воспользовался советом viter.alex искал преобразователи псевдографики которые могли бы мне помочь, перелопатив весь интернет, так ничего подходящего, для моего случая, не нашел. sad  Прошу помочь хотя бы в таком: Можно ли макросом хотя бы группировать текст который должен находиться в одной ячейке, то есть в нашем случае текст: "Помічник Голови Державної митної служби України з питань взаємодії з правоохоронними органами" чтобы находился в одной строке, единичка в следующей, текст "Помічник начальника управління організації боротьби з контрабандою та порушеннями митних правил Державної митної служби України" еще ниже и т. д. Помогите пожалуйста я в отчаянии, буду очень благодарен.

12

Re: Замена текста на таблицу

Roman, если у вас разные таблицы и предложенный мною макрос подходит только для одного варианта, то выложите все варианты таблиц. Я не буду писать макрос для каждой, но можно попробовать выработать общие рекомендации по оформлению.

Лучше день потерять — потом за пять минут долететь!

13

Re: Замена текста на таблицу

viter.alex боюсь это не реально их тысячи, может можно хотя бы разбить текст так как я предлагаю, таблицу для меня не составит проблем создать и загнать в нее текст.

14

Re: Замена текста на таблицу

Roman пишет:

может можно хотя бы разбить текст так как я предлагаю

Вот это как раз нереально. Понятно, что таблиц тысячи, но общие признаки у них есть? Приведённая таблица является самой простой: два столбца, строки отделены дефисами, столбцы вертикальной чертой. Объединённых ячеек нет. Любая таблица, соответствующая этой классификации, будет корректно обрабатываться макросом.
Прежде чем решать задачу, её нужно максимально формализировать. Одной таблицы для этого недостаточно. Нужно видеть другие примеры.

Лучше день потерять — потом за пять минут долететь!

15

Re: Замена текста на таблицу

Ок, выложу парочку вариантов  smile

16

Re: Замена текста на таблицу

Вот например такой вариант:

Post's attachments

primer.txt 3.23 Кб, 4 скачиваний с 2010-03-25 

You don't have the permssions to download the attachments of this post.

17

Re: Замена текста на таблицу

И такой:

Post's attachments

primer 2.txt 3.64 Кб, 2 скачиваний с 2010-03-25 

You don't have the permssions to download the attachments of this post.

18

Re: Замена текста на таблицу

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

Post's attachments

RecognizeTable v.1.bas 8.24 Кб, 3 скачиваний с 2010-03-25 

You don't have the permssions to download the attachments of this post.

19

Re: Замена текста на таблицу

viter.alex вы про меня не забыли? что скажите реально сделать то что я прошу?

20

Re: Замена текста на таблицу

Я не забыл, варианты посмотрел. То, что вы хотите сделать нельзя. Но можно приблизиться, анализируя каждую таблицу по отдельности, выискивая общие признаки и на основе этих общих признаков пытаться делать.
А вы вручную пробовали эти таблицы делать?

Лучше день потерять — потом за пять минут долететь!

21

Re: Замена текста на таблицу

Да пробовал и делал, занимает уйму времени, хотелось бы хоть немного ускорить процесс

22

Re: Замена текста на таблицу

Я извиняюсь, а что там с этим макросом RecognizeTable v.1.bas, вы не пробовали, почему он вылетает с ошибкой может там можно что то поправить...

23

Re: Замена текста на таблицу

Даже не пробовал. Открыл, посмотрел, но углубляться нет времени.

Лучше день потерять — потом за пять минут долететь!

24

Re: Замена текста на таблицу

А когда будет время глянете? ну очень нужно ...

25

Re: Замена текста на таблицу

Роман, у нас есть раздел Заявки на разработку, где можно попросить решить этот вопрос за небольшое вознаграждение.
Так сказать, стимул для специалиста.

26

Re: Замена текста на таблицу

Антон, дело ведь даже не в деньгах. У меня просто знаний не хватает, чтобы взяться за эту глобальную задачу

Лучше день потерять — потом за пять минут долететь!

27

Re: Замена текста на таблицу

Роман, мне нужны все возможные варианты файлов у которых разные шапки и количество столбцов. Можете написать отдельное сообщение личное, я отвечу по почте. Уже делал такую работу лет восемь назад, думаю, что смогу хоть чем-то вам помочь! С приведенными файлами за несколько минут руками все сделал. Могу просто написать для вас очень подробную инструкцию, как, что и зачем делать, думаю, что на примере трех или четырех разных файлов Вы и сами научитесь это делать. Специального макроса, который бы обработал все ваши таблицы, вы не найдете. Нужно просто отсортировать по типам шапок и количеству столбцов файлы, и для каждого типа макрорекордером записать макрос. Но не факт, что и он будет работать. В каждом конкретном случае нужно разбираться..