Страницы: 1
RSS
Как огромную таблицу Word экспортировать в Excel
 
Здравствуйте!  Моя фантазия иссякла, а вопрос не решается. Есть таблицы в ворде. Огромные. (Столбцов 9-12, строк до 65000). С ними надо работать(рыдаю). Размеры файлов 40-60 Мб. Ресурсы на машинах не велики, да и ворд не приспособлен под такие таблицы. Надо перетянуть в Excel.
Что сработало: преобразовать таблицу в текст и сохранить в формате обычный текст, затем открыть txt файл в Excel. Занимает огромное количество времени(около часа), да и строк было 15500. На 60000 даже боюсь пробовать.
Пыталась сохранить как веб-документ MHTML размер файла увеличился более чем в два раза и затянуть в PQ - не хватает ресурсов памяти, пишет: Expression.Error: При вычислении возникла нехватка памяти. Продолжение невозможно. Что еще можно предпринять? Или какие минимальные параметры должны быть у машины для работы с такими файлами?
 
а просто Ctrl+C в Word и Ctrl+V в ячейке A1 пустого файла Excel не работает?
 
Выложите ссылку на "огромный файл" Word (если сложно, то можно строк 1000, до 60 000 сами размножим).
Владимир
 
файлы содержат конфиденциальную информацию, выложить не могу. В среднем, каждое поле содержит до 50 символов, но 4 поля содержат от 200 до 400 символов.

Цитата
New написал: а просто Ctrl+C в Word и Ctrl+V в ячейке A1 пустого файла Excel не работает?
не работает, подтягивает около 5 тыс. строк и все.
 
Цитата
Sii написал:
файлы содержат конфиденциальную информацию
Замените патроны на апельсины.
 
Цитата
Юрий М написал:
Замените патроны на апельсины.
патроны меняются, не знаю, сколько времени это будет происходить. А это характеристики трудяги:  
Изменено: Sii - 16.01.2021 23:28:59
 
Если там вордовская таблица нормальная
то можно все собрать в массив и выгрузить в excel
Вот пример сбора в массив.
Код
Sub GetTableToArray()
Set doc = ActiveDocument
tbl = doc.Tables(1)
i = 1
j = 1
ReDim a(1 To tbl.Rows.Count, 1 To tbl.Columns.Count)
For Each x In tbl.Cells
    a(x.RowIndex, x.ColumnIndex) = x.Range.Text
Next
End Sub
Спасибо
 
R Dmitry,  тогда уж так с переносом данных в Excel
P.S. Кто подскажет - тестировал этот код и у меня получается каждая ячейка завершается символом Chr(10) (хотя её нет в таблице Word), пытаюсь все эти переносы убрать заменой, но они не убирается. Каждая ячейка в Excel заканчивается этим символом, как их убрать?)  Chr(13) тоже пробовал
Код
Sub GetTableToArray()
Dim arrData, tbl, x, doc As Document, iText As String
Dim objExcelApp As Object, ojbWorkbook As Object

    Set doc = ActiveDocument
    tbl = doc.Tables(1)
    ReDim arrData(1 To tbl.Rows.Count, 1 To tbl.Columns.Count)
    For Each x In tbl.Cells
        iText = x.Range.Text
        'iText = Replace(iText, Chr(10), "") 'не работает замена Chr(10) на пусто
        arrData(x.RowIndex, x.ColumnIndex) = iText
    Next
    Set objExcelApp = CreateObject("Excel.Application")
    Set ojbWorkbook = objExcelApp.workbooks.Add
    ojbWorkbook.worksheets(1).Range("A1").Resize(UBound(arrData, 1), UBound(arrData, 2)).Value = arrData
    objExcelApp.Visible = True
End Sub
Изменено: New - 18.01.2021 03:17:24
 
А там точно Chr(10)?
Попробуй vbCrLf или vbNewLine
 
Разобрался, там 2 символа добавляются к тексту в каждой ячейке Chr(10) и Chr(7). Вот так нормально переносится (без конечных переносов)
Код
Sub GetTableToArray()
Dim arrData, tbl, x, doc As Document, iText As String
Dim objExcelApp As Object, ojbWorkbook As Object

    Set doc = ActiveDocument
    tbl = doc.Tables(1)
    ReDim arrData(1 To tbl.Rows.Count, 1 To tbl.Columns.Count)
    For Each x In tbl.Cells
        iText = x.Range.Text
        iText = Replace(Replace(iText, Chr(13), ""), Chr(7), "") 'замена символов переноса в конце каждой ячейки
        arrData(x.RowIndex, x.ColumnIndex) = iText
    Next
    Set objExcelApp = CreateObject("Excel.Application")
    Set ojbWorkbook = objExcelApp.workbooks.Add
    ojbWorkbook.worksheets(1).Range("A1").Resize(UBound(arrData, 1), UBound(arrData, 2)).Value = arrData
    objExcelApp.Visible = True
End Sub
 
Пока менялись патроны, простите, уснула. Файл увеличился в два раза. Запустила макрос с утра, работает уже 40 минут, результата пока нет.
Ссылка на пример https://yadi.sk/d/CG1hEgIqQF2S0g
 
Я бы наверно, запустил из excel , word бы сделал visible=false
и еще проверку орфографии убрал бы.
Код
Application.Options.CheckSpellingAsYouType = False
Изменено: R Dmitry - 17.01.2021 13:30:43
Спасибо
 
Sii,у вас файл в формате RTF - 90мб, а если его пересохранить в формат DOCX, то он вестит 2,4мб
 
Sii,
а обычный конвертер Word в Excel что в отношении вашей операции "говорит"? Пробовали?
 
Цитата
Olga H. написал:
а обычный конвертер Word в Excel
а что это?  
 
Цитата
Цитата
New написал:
Sii ,у вас файл в формате RTF - 90мб, а если его пересохранить в формат DOCX, то он вестит 2,4мб
Таки думаю надо менять комп, процесс пересохранения затягивается, уже минут 50, но еще не вылетел. Может все-таки сохранит
 
Ещё желательно, чтобы диск SSD был, а не HDD. SSD быстрее работают с файлами - запись/чтение/сохранение/открытие.
Запучтил код выше на вашем файле, тоже долго работает
Изменено: New - 17.01.2021 19:10:54
 
диск и у меня SSD, без него совсем все плохо было
 
ну, макрос у меня до конца нормально отработал. Не знаю, сколько он работал, я уехал в Ашан, сейчас вернулся и все данные из таблицы перенеслись в Excel (15000 строк и 12 столбцов). То есть разово такую операцию можно сделать и далее работать в Excel
Изменено: New - 18.01.2021 01:42:52
 
New,
уточните пожалуйста, в каком сообщении был макрос, который у вас сработал. Хочу сделать себе закладку, вдруг понадобится.
 
В моём сообщении #10
 
Вопрос решается путем замены компа, где процессор хотя бы 3,2GHz.
 
Добрый день. Замена компа не поможет, но повод заменить - хороший ))
Такой код в Excel отработал у меня на примере из сообщения #11 за 15 секунд:
Код
Sub WordTableToExcel()
'ZVI:2021-01-19 https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&TID=136468#message1109953

  Dim a, b()
  Dim r As Long, c As Long, rs As Long, cs As Long, i As Long
  Dim t As Single, t1 As Single
  
  t = Timer: t1 = t
  On Error GoTo exit_
  Debug.Print "Read",
  With GetObject(, "Word.Application").ActiveDocument.Tables(1)
    rs = .Rows.Count
    cs = .Columns.Count
    a = Split(.Range.Text, Chr(13) & Chr(7))
    .Parent.Close False
  End With
  Debug.Print Round(Timer - t, 3) & " s": t = Timer
  
  Debug.Print "Rebuild",
  ReDim b(0 To rs, 0 To cs - 1)
  For r = 0 To rs - 1
    For c = 0 To cs
      If c < cs Then b(r, c) = a(i)
      a(i) = Empty
      i = i + 1
    Next
  Next
  Debug.Print Round(Timer - t, 3) & " s": t = Timer
  
  Debug.Print "Write",
  Range("A1").Resize(rs, cs).Value = b()
  Debug.Print Round(Timer - t, 3) & " s"
  Debug.Print "Total", Round(Timer - t1, 3) & " s"
  
exit_:
  If Err Then MsgBox Err.Description, vbExclamation, "Word document not found!"
  
End Sub

Для экономии общей памяти (это не обязательно) документ Word закрывается строчкой .Parent.Close False
Изменено: ZVI - 19.01.2021 07:08:27
Страницы: 1
Наверх