Регулярные выраженияДанная статья является вольным переводом статьи John Nurick об использовании регулярных выражений в Excel для добычи знаний (data mining).

Иногда бывает необходимо провести анализ строки данных, находящейся в ячейке или поле ввода и вывести какую-либо ее часть. Встроенные формулы Excel и функции, доступные в VBA, такие как ПОИСК() / InStr() или ПСТР() / Mid() справляются с этой задачей, но весьма ограниченно. Провести сложный анализ с помощью этих функций можно, но придется попотеть над кодом, т.к. они не предполагают поиск текста по шаблону.

Простой пример – выделить из строки, содержащей адрес, почтовый индекс (6 идущих подряд цифр, например «451236»). Хорошо, если индекс всегда находится в начале строки, но если же нет, то задача его выделения из общего текста нетривиальна при использовании стандартных средств Excel.

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

Установка и тестирование

rgxExtract() может быть использована как в редакторе VBA Excel, так и в других приложениях, например среде программирования Visual Basic и базах данных Access. Для использования функции необходимо скопировать ее в существующий или новый модуль книги Excel (в т.ч. личной книге макросов).

Для проверки работоспособности используем в редакторе VBA окно Immediate (Ctrl+G). Введем команду и нажмем Enter для получения первой части строки, начинающиеся на заглавную или строчную букву:

Ввод: ? rgxExtract("Иванов Иван Иванович", "[А-Яа-я]+", 0)
Вывод: Иванов

Попробуем изменить второй параметр на цифру 1 и получим вторую часть строки – имя:

Ввод: ? rgxExtract("Иванов Иван Иванович", "[А-Яа-я]+", 1)
Вывод: Иван

Теперь введем функцию анализа строки с номером телефона:

Ввод: ? rgxExtract("(495) 250-0102", "(\d{3})\)?[- ]?(\d{3})[- ]?(\d{4})", 0)
Вывод: 495

Обратите внимание на различия в использовании (скобок) и {фигурных скобок}.

Поиграйте с последней функцией, изменяя последний параметр и посмотрите, что получится. Попробуйте изменить строку с номером телефона на «495-250-0102», потом на «4952500102» и наконец, на «4952500102 с 9 до 20». Результат в любом из случаев будет одинаковым – «495».

Если возникла ошибка

Если при тестировании возникает ошибка rgxExtract(): Could not create VBScript.Regexp object, это означает, что функция не смогла инициализировать объект VBScript, отвечающий за использование регулярных выражений.

Наиболее вероятные причины возникновения ошибки:

  • VBScript и/или сервис Windows Scripting не установлен (отключен) на вашем компьютере;
  • Антивирусная система блокирует запуск этих сервисов.

Аргументы функции

Функция rgxExtract() принимает до 6-и аргументов, при этом обычно используется не более 2-х. Вы можете использовать следующие аргументы:

Target As Variant

Строка, анализ которой производится по шаблону (Pattern). Параметр задекларирован в качестве Variant для упрощения использования в Access, когда пустые строки возвращают значение Null. В этом случае функция также вернет Null.

Pattern As String

Шаблон или регулярное выражение, которое используется для анализа строки (Target). Не смотря на то, что в функции она опциональна, указание ее обязательно.

Item As Long

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

Если параметр Item опущен, функция выдает первое или единственное вхождение.

Если параметр Item >=0, функция выдает соответствующее вхождение, где 0 – первое вхождение, 1 – второе, и так далее. Если значение параметра превысит общее число вхождений, функция возвратит ошибку либо Null, если параметр FailOnError установлен в значении false.

Если параметр Item < 0, то функция вернет последнее вхождение. На примере анализа строки с полным именем, параметр в значении -1 вернет «Иванович», -2 – «Иван».

Остальные, менее используемые параметры:

CaseSensitive As Boolean

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

FailOnError As Boolean

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

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

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

Persist as Boolean

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

Установите параметр в значение true, чтобы объект был создан однажды и использован для всего массива успешно обрабатываемых данных. Это позволит существенно ускорить выполнение обработки.

Код

Public Function rgxExtract(Optional ByVal Target As Variant, _
    Optional Pattern As String = "", _
    Optional ByVal Item As Long = 0, _
    Optional CaseSensitive As Boolean = False, _
    Optional FailOnError As Boolean = True, _
    Optional Persist As Boolean = False) _
  As Variant

    'Regular expression matching function suitable for use
    'in VB/A generally and in Access queries.
    'By John Nurick. Updated 14 Jan 06.

    'Takes a search string (Target) and a regular expression
    '(Pattern), and an optional Item argument.
    '- If Item is omitted and a substring of Target matches Pattern,
    '  returns that substring.
    '- If Pattern includes grouping parentheses, a substring of Target
    '  matches Pattern, and Item is an integer, returns the submatch
    '  specified by Item (first submatch is item 0). If there aren't
    '  enough submatches, returns Null. Negative values of Item start
    '  counting with the last submatch.
    '- If no match, returns Null.
    '- Returns Null on error unless FailOnError is True.
    '  Always matches against the entire Target (i.e. Global and
    '  Multiline are True).

    'CaseSensitive matches regardless of case.

    'Persist controls whether the compiled RegExp object
    'remains in memory ready for the next call to the
    'function or whether it is disposed of immediately. This
    'means the function can be used in queries without having
    'to create, compile, use and destroy a new RegExp object for
    'each row being processed. But it also means that the object
    'remains in memory after the query has run. To destroy the
    'object and release the memory, call this function one
    'last time with no arguments.

    'Calling the function with different arguments (e.g. a new
    'Pattern) recompiles the RegExp object, so
    'the function can be used in different queries. However there
    'may be problems if two threads are calling the function at
    'the same time.

    Const rgxPROC_NAME = "rgxExtract"
    Static oRE As Object 'VBScript_RegExp_55.RegExp
        'Static declaration means we don't have to create
        'and compile the RegExp object every single time
        'the function is called.
    Dim oMatches As Object 'VBScript_RegExp_55.MatchCollection

    On Error GoTo ErrHandler
    rgxExtract = Null 'Default return value
        'NB: if FailOnError is false, returns Null on error

    If IsMissing(Target) Then
        'This is the signal to dispose of oRE
        Set oRE = Nothing
        Exit Function 'with default value
    End If

    'Create the RegExp object if necessary
    If oRE Is Nothing Then
        Set oRE = CreateObject("VBScript.Regexp")
    End If

    With oRE
        'Check whether the current arguments (other than Target)
        'are different from those stored in oRE, and update them
        '(thereby recompiling the regex) only if necessary.
        If CaseSensitive = .IgnoreCase Then
            .IgnoreCase = Not .IgnoreCase
        End If
        .Global = True
        .MultiLine = True
    '    If Multiline <> .Multiline Then
    '      .Multiline = Multiline
    '    End If
        If Pattern <> .Pattern Then
            .Pattern = Pattern
        End If

    'Finally, execute the match
        If IsNull(Target) Then
            rgxExtract = Null
        Else
            Set oMatches = oRE.Execute(Target)
            If oMatches.Count > 0 Then
                If oMatches(0).SubMatches.Count = 0 Then
                    'No ( ) group in Pattern: return the match
                    If Item < 0 Then 'we're counting from last item
                        'convert to count from the first item
                        Item = oMatches.Count + Item
                    End If
                    Select Case Item
                        Case Is < 0
                            'Negative Item originally passed exceeded the
                            'number of matches
                            rgxExtract = Null
                            If FailOnError Then
                                Err.Raise 9
                            End If
                        Case Is >= oMatches.Count
                            'Positive Item exceeded the number of matches
                            rgxExtract = Null
                            If FailOnError Then
                                Err.Raise 9
                            End If
                        Case Else
                            rgxExtract = oMatches(Item)
                    End Select

                Else  'There are one or more ( ) captured groups in Pattern
                            'return the one specified by Item
                    With oMatches(0).SubMatches
                        If Item < 0 Then 'we're counting from last item
                            'convert to count from the first item
                            Item = .Count + Item
                        End If
                        Select Case Item
                            Case Is < 0
                                'Negative Item originally passed exceeded the
                                'number of submatches
                                rgxExtract = Null
                                If FailOnError Then
                                    Err.Raise 9
                                End If
                            Case Is >= .Count
                                'Positive Item exceeded the number of submatches
                                rgxExtract = Null
                                If FailOnError Then
                                    Err.Raise 9
                                End If
                            Case Else 'valid Item number
                                rgxExtract = .Item(Item)
                        End Select
                    End With
                End If
            Else
                rgxExtract = Null
            End If
        End If
    End With

    'Tidy up and normal exit
    If Not Persist Then Set oRE = Nothing
    Exit Function

ErrHandler:
    If FailOnError Then
        With Err
            Select Case .Number
                'Replace the default "object-defined error" message
                Case 9: .Description = "Subscript out of range (the Item number requested " _
                    & "was greater than the number of matches found, or than the number of " _
                    & "(...) grouping/capturing parentheses in the Pattern)."
                Case 13: .Description = "Type mismatch, probably because " _
                    & "the ""Target"" argument could not be converted to a string"
                Case 5017: .Description = "Syntax error in regular expression"
                Case 5018: .Description = "Unexpected quantifier in regular expression"
                Case 5019: .Description = "Expected ']' in regular expression"
                Case 5020: .Description = "Expected ')' in regular expression"
            Case Else
                If oRE Is Nothing Then 'Failed to create Regexp object
                    .Description = "Could not create VBScript.RegExp object. " & Err.Description
                Else 'Unexpected error
                    .Description = rgxPROC_NAME & ": " & .Description
                End If
            End Select
            Set oRE = Nothing
            .Raise Err.Number, rgxPROC_NAME, _
                    rgxPROC_NAME & "(): " & .Description
        End With
    Else 'Fail silently
        Err.Clear
        Set oRE = Nothing
    End If
End Function

Скачать Excel 2003, Excel 2007+

Добавить комментарий


Защитный код
Обновить

Вверх