Поиск документа Word из Excel

Сегодня я создал сценарий в Excel, который переносит данные из определенного документа Word и копирует часть его в ячейку в Excel (определенная дата).

Вход файла

  

Фамилия, имя, класс - (ранг) (Завершено в ГГГГ-ММ-ДД ЧЧ: мм: сс)

, и каждый человек находится в новом «абзаце» (aka line) в Word.

Sub SearchTextFile()
Dim i As Integer
Dim currentCellNumberLname As String
Dim currentCellNumberFname As String
Dim currentCellData As String
Dim firstPlusLastName As String
Dim filePath As String
filePath = "C:\Users\<user>\Desktop\CyberAwareness.docx"

For i = 2 To 4
    currentCellNumberLname = "C" & i
    currentCellNumberFname = "D" & i
    currentCellToAdd = "L" & i
    ActiveSheet.Range(currentCellToAdd).Activate
    ActiveWindow.ScrollRow = ActiveCell.Row
    firstPlusLastName = Range(currentCellNumberLname).Value & ", " & Range(currentCellNumberFname).Value
    Range(currentCellToAdd) = SearchWordDoc(filePath, firstPlusLastName)
Next
End Sub

'Searches word file for name, finds the associated paragraph, and returns the date'
Function SearchWordDoc(strPath, strName)
Set objword = CreateObject("word.application")
Set a = objword.documents.Open(strPath)

For i = 1 To a.Paragraphs.Count
    If InStr(a.Paragraphs(i).Range.Text, strName) <> 0 Then
        SearchWordDoc = Left(Right(a.Paragraphs(i).Range.Text, 22), 11)
    End If
Next i
a.Close
objword.Quit
'    objword.Visible = False'
Set objword = Nothing
End Function

У меня около 300 сотрудников, которым нужна информация, введенная в этот документ, и около 8 разных столбцов, которые мне нужно заполнить. Скрипт работает на удивление хорошо, однако он довольно медленный и занимает около 10 минут для одного столбца. Я в порядке с ним, так как он выполняет эту работу, но мне любопытно, есть ли способ упорядочить ее дальше и, возможно, добавить проверку ошибок (для несоответствий имен).

11 голосов | спросил slow_excellence 11 thEurope/Moscowp30Europe/Moscow09bEurope/MoscowThu, 11 Sep 2014 22:51:14 +0400 2014, 22:51:14

2 ответа


6

Общие примечания

Первый . В дополнение к замене магических чисел я поставил ваш путь к файлу в константу в верхней части модуля для упрощения обслуживания:

Private Const WORD_DOCUMENT_LOCATION As String = "C:\Users\<user>\Desktop\CyberAwareness.docx"

Второй . Получите ссылку на объект Worksheet в начале функции вместо того, чтобы полагаться на вызовы на ActiveSheet

Dim sheet As Worksheet
Set sheet = ActiveSheet

Третий - Использование адресации диапазона C2 или L3 не только труднее читать, но и менее эффективно. Вам не только нужно объединять строки, чтобы создавать адреса, но Excel просто должен преобразовать их обратно в числовые индексы. Если у вас нет по-настоящему веской причины не делать этого, использование .Cell(row, column) почти всегда лучше и намного проще использовать в циклах.

'Instead of this...
sheet.Range("A" & i).Value = foobar
'...do this:
sheet.Cells(i, 1).Value = foobar

Четвертый . Привыкнуть к объявлению области ваших подписок и функций, чтобы убедиться, что вы только разоблачаете те, которые вы намереваетесь. Если вы оставите их выключенными, они по умолчанию станут общедоступными и начнут отображаться в вашем списке функций в книге и будут доступны для автозаполнения. Если это не то, что вы хотели бы показать в ячейке, то есть =SearchWordDoc("this raises","an error"), объявите его как Private

Наконец . Объявите типы возвращаемых функций. Непонятно, что возвращает код ниже, а комментарий делает его хуже - он не возвращает код Date вообще, он возвращает String.

'Searches word file for name, finds the associated paragraph, and returns the date'
Function SearchWordDoc(strPath, strName)

В сочетании с вышеприведенным пунктом объявление функции должно действительно выглядеть примерно так:

Private Function SearchWordDoc(filepath, name) As String

Производительность

Как отметил @RubberDuck, наибольшее повышение производительности, которое вы собираетесь получить, - это не из-за неоднократного открытия и закрытия документа Word. Большинство других предложений на месте, поэтому я ограничу этот ответ аспектом производительности кода.

На основе вашего существующего кода очевидно, что в документе Word есть только одна строка на человека, и все строки имеют (или должны иметь) ту же структуру. В основном вы выполняете поиск в файле Word на основе ключа. У VBA есть объект, который предназначен для выполнения ключевых поисков, которые на порядок быстрее, чем метод Word .Find - Scripting.Dictionary. Все, что вам нужно сделать, - сначала проанализировать документ как текст для создания вашего объекта. Например (со ссылкой на исполняемый файл Microsoft Scripting Runtime):

Private Function LoadWordRecords(filepath As String) As Scripting.Dictionary

    Dim host As New Word.Application
    Dim doc As Word.Document
    Dim lines() As String

    Set doc = host.Documents.Open(filepath)
    'Take the whole document in one shot, and read to an array of paragraphs...
    lines = Split(doc.Content.text, vbCr)
    '...and dispense with Word.
    doc.Close
    host.Quit

    'Then do whatever you need to do to parse the text into a useful structure:
    Dim output As New Scripting.Dictionary
    Dim items() As String
    Dim i As Integer

    'Parse each line in the Word document to extract a key for the line.
    For i = 0 To UBound(lines)
        'Add whatever you need to validate the paragraph you're parsing.
        'Test the input line to see if it contains a comma.
        If (InStr(1, lines(i), ",") > 0) Then
            'Split into an array from the comma delimited string.
            items = Split(lines(i), ",")
            'Add the resulting item to the Dictionary with the key defined
            'as the first 2 elements and the value as the remainder of the line.
            Call output.Add(Trim$(items(0)) & ", " & Trim$(items(1)), items(2))
        End If
        'Or whatever is convenient.
    Next i

    Set LoadWordRecords = output

End Function

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

Public Sub SearchTextFile()

    Dim sheet As Worksheet
    Set sheet = ActiveSheet

    Dim i As Integer
    Dim currentCellNumberLname As String
    Dim currentCellNumberFname As String
    Dim currentCellData As String
    Dim firstPlusLastName As String

    'Load your lookup object:
    Dim entries As Scripting.Dictionary
    Set entries = LoadWordRecords(WORD_DOCUMENT_LOCATION)

    For i = 2 To 4
        currentCellNumberLname = "C" & i
        currentCellNumberFname = "D" & i
        currentCellToAdd = "L" & i
        ActiveSheet.Range(currentCellToAdd).Activate
        ActiveWindow.ScrollRow = ActiveCell.row
        firstPlusLastName = sheet.Range(currentCellNumberLname).Value & ", " & sheet.Range(currentCellNumberFname).Value

        'Retrieve lines by keys for parsing:
        sheet.Range(currentCellToAdd) = Left(Right(entries(firstPlusLastName), 22), 11)
    Next

End Sub

Мое правило состоит в том, что вызовы Windows COM обычно дороги, и их лучше избегать, если существуют альтернативы. Это должно заканчиваться порядка секунд, а не минут, и большая часть времени обработки должна поступать от простого открытия документа Word.

ответил Comintern 16 thEurope/Moscowp30Europe/Moscow09bEurope/MoscowTue, 16 Sep 2014 05:45:35 +0400 2014, 05:45:35
5

Производительность

Я вижу три основные проблемы с производительностью этого кода.

  1. Операции с графическим интерфейсом являются дорогостоящими и медленными. Удалите эти строки, они ничего не делают, но замедляют вас.

    ActiveSheet.Range(currentCellToAdd).Activate
    ActiveWindow.ScrollRow = ActiveCell.Row
    

    Вы должны избегать активации и выбора в любом случае . Они, как правило, приводят к неприятным ошибкам.

  2. Не перебирайте весь текст в документе слова. Найдите его вместо . Вот несколько псевдо-кода, чтобы вы начали.

    Dim doc as Document
    Dim currentRange as Range
    
    Set doc = ActiveDocument
    Set currentRange = doc.Range
    
    With currentRange.Find
        .Forward = True
        .Text = strName
        .Execute 'execute will update current range to the first found instance
    
        If .Found Then
            SearchWordDoc = currentRange.Text ' in reality, I suspect you'll need to offset this
        End If
    End With    
    

    Если вам интересно, вы можете взглянуть на этот пример использования Range.Find в слове .

  3. Вы создаете новый экземпляр Word и , открываете тот же самый документ каждый раз, когда вы вызываете SearchWordDoc. Создание экземпляра Word и открытие документов - это медленные и дорогостоящие операции. Вы должны указать Word и открыть документ внутри SearchTextFile и передать документ в качестве аргумента.

Другие примечания

  • Отцепите венгерскую нотацию. Вы не делаете это правильно , но не чувствуете себя плохо. Никто на самом деле не делает.

  • Замените Магические числа со значимо названными константами.

      

    При i = 2 To 4

    Я предполагаю, что firstColumn и lastColumn было бы хорошо здесь.

  • Вам следует использовать Option Explicit . Это заставляет вас объявлять все ваши переменные. Это означает, что все будет строго типизировано, что хорошо. Он останавливает множество неприятных ошибок во время выполнения.

  • Я настоятельно рекомендую вам использовать раннее связывание вместо позднего связывания. Это своего рода дискуссионная тема, но я думаю, что преимущества перевешивают недостатки. Просто имея intellisense один делает раннее связывание стоит это в моем сознании.

Быстрое повышение производительности

Внутри SearchWordDoc вы можете объявить i как статическая переменная . Это позволит i сохранить его значение между казнями. Это, по сути, отслеживание последнего абзаца, в котором вы нашли то, что искали. Однако следует предупредить, что статические переменные делают код запутанным и трудно отлаживают. Я не рекомендую его в качестве долгосрочного решения.

ответил RubberDuck 11 thEurope/Moscowp30Europe/Moscow09bEurope/MoscowThu, 11 Sep 2014 23:55:54 +0400 2014, 23:55:54

Похожие вопросы

Популярные теги

security × 330linux × 316macos × 2827 × 268performance × 244command-line × 241sql-server × 235joomla-3.x × 222java × 189c++ × 186windows × 180cisco × 168bash × 158c# × 142gmail × 139arduino-uno × 139javascript × 134ssh × 133seo × 132mysql × 132