Страницы: 1
RSS
Перенос таблицы из word с помощью VBA, оптимизация кода
 
Всем привет,

есть у меня пару ворд файлов, длинных, с большой таблицей в примерно 3к строк (выгрузка). Эти таблицы нужно закинуть в эксель.
Написал код. Закидываю значения в массив, потом уже буду с этим массивом дальше работать. Однако обработка оставляет желать лучшего, около 5ти минут считывает данную таблицу. Код не большой, может быть кто то уже делал похожие вещи и знает хитрости, к примеру может быть скопировать таблицу как нибудь целиком, или что нибудь похожее.

Всем заранее спасибо!

Код
Sub SaveTableToArray()
    Dim tableArray() As Variant
    Dim wordApp As Word.Application
    Dim tbl As Word.Table
    Dim i As Long, j As Long

    Set wordApp = New Word.Application
    wordApp.Visible = False
    wordApp.Documents.Open "D:\Test\doks.doc"
    Set tbl = wordApp.ActiveDocument.Tables(2)

    ReDim tableArray(1 To tbl.Rows.Count, 1 To tbl.Columns.Count)

    For i = 1 To tbl.Rows.Count
        For j = 1 To tbl.Columns.Count
            tableArray(i, j) = tbl.Cell(i, j).Range.Text
        Next j
    Next i

    wordApp.Quit
    Set wordApp = Nothing
End Sub
 
Копируйте таблицу из Word в лист Excel, а оттуда одним махом в массив загоняйте. Вы же из Excel запускаете данный код?
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий(The_Prist) Щербаков, Копировать в ручную? Если да, то вариант не подходит, файлов ворд будет несколько и они будут добавлятся в папку, нужно будет по итогу их все в одну таблицу собрать.  
 
Цитата
написал:
Копировать в ручную?
зачем, у Вас же уже есть код подключения к Word. Вместо построчного считывания копируете таблицу и вставляете в лист Excel. А оттуда уже считываете одним махом:
Код
Sub SaveTableToArray()
    Dim tableArray() As Variant
    Dim wordApp As Word.Application
    Dim tbl As Word.Table
    Dim i As Long, j As Long
 
    Set wordApp = New Word.Application
    wordApp.Visible = False
    wordApp.Documents.Open "D:\Test\doks.doc"
    Set tbl = wordApp.ActiveDocument.Tables(2)
 
    tbl.Range.Copy
    Cells(1, 1).PasteSpecial xlPasteValues 'вставляем в ячейку А1 текущего листа Excel
    'считываем все вставленные данные в массив
    'если будет сбор на этот же лист - то массив вообще не нужен. Можно просто вставлять в следующую пустую строку и все
    tableArray = Cells(1, 1).Resize(tbl.Rows.Count, tbl.Columns.Count).Value
 
    wordApp.Quit
    Set wordApp = Nothing
End Sub

Цитата
написал:
по итогу их все в одну таблицу собрать
в этом случае вообще можно в цикле собирать и просто копировать таблицы на лист без всяких массивов. Выше в коде показал, как это сделать.
Изменено: Дмитрий(The_Prist) Щербаков - 10.02.2023 14:10:24
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий(The_Prist) Щербаков, супер, спасибо, Вы крутой!
Страницы: 1
Наверх