Dummy about Dummies и одно увлекательное путешествие в недра Excel. Долгожданный RegExp в таблицах

Пролог, просто пролог!

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

Криптонит для чайника.

Знакомьтесь, я чайник! Вообще-то я и правда не особо силен в программировании, но особенно не комфортно себя чувствую пытаясь «что-то» создать на незнакомом мне языке. В моем рассказе «Visual Basic for Applications» и есть тот непривычный для меня язык. На самом деле, все это лирическое отступление, не более чем попытка занизить ваши ожидания.

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

Утро понедельника как всегда было отвратительным. Рассеивающаяся дымка и еле заметно срывающийся дождь — малоприятное зрелище. Желание работать отпало еще в воскресенье. Работы как всегда много, ничего не клеится, а тут еще и экселевская база на 300к строк свалилась мне в руки. Ну не то что-бы свалилась, закончила парсится. И как вы понимаете, что структурированной, форматированной и однородной базой там и не пахло, а иначе откуда статье взяться. Так что на выходе я получил громадное множество неоднородной информации, из которой необходимо было выделить то нужное, что требовалось мне для работы, отсекая все остальное.

Экспозиция чайника

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

Как и любой другой здравомыслящий человек я обратился за помощью на спец форум с тусовкой бухгалтеров и excel'евских гиков. Рекламировать форумы, на которых я просил помощи, не стану, замечу только, что из 5 популярных помочь мне согласились лишь на двух. Ребята если вы это читаете — огромное спасибо!

В общем, оставив свой вопрос, я принялся искать решение самостоятельно.

Завязка чайника

Мои задачи были весьма типичны и просты. В таблице содержалась самая необходимая информация: Название (вместе с типом регистрации компании), Телефон (мобильные и городские вперемешку), Адрес (редкостная муть), Сайт компании (тут на удивление все в порядке), email (маловажная инфа, но все же для галочки — грабанул) и Отрасль/Рубрика. Все это мне необходимо было привести в надлежащий вид, для последующего экспортирования в crm.

Дождавшись долгожданного ответа, принялся применять его на практике. Итог — стало еще хуже. Безусловно, я нефигово утрирую, но все же та формула (кстати, ад адский, а не формула), которую мне предоставил один из отзывчивых форумчанинов, оказалась не совсем что бы жизнеспособной. Свою функцию она, конечно, выполняла, но все это было очень муторно, долго и ужасно. Осознав, что формулы — это не вариант, я решил писать макрос.

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

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

И фиг бы с ним, но была какая-то недосказанность, незавершенность.

Бритва чайника

Сидя вечером в кресле и допивая стакан бурбона… Ага, сидел и пилил очередную халтуру, взятую на фрилансе. К моему стыду я и не вспомню в чем там была суть («Нужно больше монотонной работы» (С) War3). Но самое главное, что, применяя RegExp в поле верификации e-mail'a, меня вдруг осенило, а что если… Да-да, спустя столько бесполезных слов, я наконец-то подошел к самому главному. А что если применить регулярные выражения для жонглирования значениями внутри таблицы?



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

Триумф чайника

Победный танец прервала ошибка в выполнении моего макроса версии 2.0. К слову сказать, мажорные обновления я выпускал так же часто, как оборачиваясь, проверить, нет ли кого за спиной. Паранойя, знаете ли.
О чем это я? Ах да, в последствии выяснилось, что суть ошибки была в случайно занесенной переменной в кавычки и неправильное количество сабматчей. Исправив сей недочет, принялся допиливать функционал конкретно под свою задачу. Cпустя 2 часа я-за-кончил. Конечный макрос успешно форматировал и отделял телефону по коду оператора (дифференцируя по коду как мобильные, а остальные как городские), разделял название предприятия и тип регистрации, а так же выделял из адреса город компании и заносил его в отдельный столбец.

Ничего особенного, скажете вы? И будете абсолютно правы. Большинство людей, умеющих работать с excel на уровне «продвинутого пользователя», сделали бы ту же операцию за 15 минут при помощи формул и базовых функций форматирования. Но я был счастлив и решил поделится этим счастьем с другими.

Итог, просто итог!

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



Отделить — отделяет значения по заданной маске в новый столбец, оставляя исходный столбец нетронутым.
Важное замечание: из-за недостатка опыта и знаний мне так и не удалось заставить макрос создать новый пустой столбец справа от редактируемого. Это значит, что соседний справа столбец должен быть пуст, иначе выходные\конечные данные заменят исходное содержимое.

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

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

ИСТИНА/ЛОЖЬ — дополнительный инструмент для взаимодействия с формулами. При совпадении маски заносит в соседний столбик значения ИСТИНА, в противном случае — ЛОЖЬ.

Хотелки или дополнительные опции

Количество групп захвата — количество масок занесенных в скобки. Пример: \d{3}\s?(.*?),\s(.*?)\. — тут их две.

Выбрать столбец — название говорит само за себя. Выбор редактируемого столбца.

Заменить на\добавить — В случае удаления по маске, заменяет удаленные значения на введенный пользователем текст. В случае отделения/разделения — добавляет в конец каждого значения или группы, введенные символы.

Результат на новом листе — результат на новом листе.

Эпилог победителя

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

200 строк ужасного кода

Private Function regexpmulti(S As Variant) 'регистрируем функцию
    'объявляем переменные
    Dim Sl As String, bRes As Boolean, RegExp As Object, oMatches As Object, n As Integer, P As String, Text As String, TextReplace As String
    Sl = ""
    ReDim x(1) As String
    bRes = False
    Set RegExp = CreateObject("VBScript.RegExp") 'подключаем библиотеку
    RegExp.Global = True
    RegExp.IgnoreCase = False ' чувствительность к регистру
    RegExp.Pattern = TextBox1.Text ' TextBox1.Text - пользовательское регулярное выражение
    On Error Resume Next ' исключаем возможность прерывания выполнения в случае переполнения памяти
    bRes = RegExp.test(S)
    If ComboBox1.Text = "" Then ' необходимое условие, что бы переменная p не оставалась пустой
    P = 0
    Else
    P = ComboBox1.Text
    End If
    If OptionButton2 Then ' исключаем путаницу с "Заменить на/Добавить"
    Text = ""
    TextReplace = TextBox2.Text
    Else
    Text = TextBox2.Text
    End If
    If bRes Then
     Set oMatches = RegExp.Execute(S) ' совпадения
        ' блок условий для количества групп захвата
        If P = 0 Or P > 5 Then
            ' передаем результат в переменную Sl
            Sl = oMatches(0) & Text ' форматирование для первого значения
            For n = 1 To oMatches.Count - 1
            Sl = Sl & oMatches(n) & Text ' форматирование для последующих
            Next
        ElseIf P = 1 Then
            Sl = oMatches(0).subMatches(0) & Text
            For n = 1 To oMatches.Count - 1
            Sl = Sl & oMatches(n).subMatches(0) & Text
            Next
        ElseIf P = 2 Then
            Sl = oMatches(0).subMatches(0) & oMatches(0).subMatches(1) & Text
            For n = 1 To oMatches.Count - 1
            Sl = Sl & oMatches(n).subMatches(0) & oMatches(n).subMatches(1) & Text
            Next
        ElseIf P = 3 Then
            Sl = oMatches(0).subMatches(0) & oMatches(0).subMatches(1) & oMatches(0).subMatches(2) & Text
            For n = 1 To oMatches.Count - 1
            Sl = Sl & oMatches(n).subMatches(0) & oMatches(n).subMatches(1) & oMatches(n).subMatches(2) & Text
            Next
        End If
        If OptionButton2 Then ' корректная замена текста удаленных значений
            S = RegExp.Replace(S, TextReplace) ' TextReplace - текст Заменить на
        End If
    End If
    Set RegExp = Nothing ' очищаем память
        If OptionButton4 Then ' если выбрано "ИСТИНА/ЛОЖЬ"
        ' магия
            If Sl <> x(0) Then
                x(0) = Sl: x(1) = "ИСТИНА"
                regexpmulti = x
            Else
                x(0) = Sl: x(1) = "ЛОЖЬ"
                regexpmulti = x
            End If
        Else
            x(0) = Sl: x(1) = S
            regexpmulti = x
        End If
End Function
Private Sub ComboBox1_DropButtonClick()
ComboBox1.List = Array("0", "1", "2", "3") ' список значений выпадающего меню
ComboBox1.style = fmStyleDropDownList 'запрет на ввод собственного значения
End Sub

Private Sub ComboBox2_DropButtonClick()
ComboBox2.List = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
ComboBox2.style = fmStyleDropDownList
End Sub

Private Sub CommandButton1_Click() ' действие после нажатия кнопки
    On Error GoTo Error 'Обработчик ошибок. Переход на обозначенное место в случае ошибки.
    'объявляем переменные
    Dim R, c
    Dim M(), RZ(), U(), S, P As String
        If ComboBox2.Text = "" Then ' убираем возможность возврата пустого значения
        S = "A" ' если пользователь не выбирает столбец, операция по умолчанию выполняется в столбце A
        Else
        S = ComboBox2.Text
        End If
    P = S & "1" & ":" & S ' Получаем строку вида "A1:A"
    M = ActiveSheet.Range(P & ActiveSheet.Range(S & Rows.Count).End(xlUp).Row).Value
    'здесь RZ - это массив, в который записываются значения, которые потом будут выгружены на лист.
    ReDim RZ(1 To UBound(M), 1 To UBound(M, 2) + 1)
    'перебираем все строки массива
    For R = 1 To UBound(M)
    If OptionButton3 Or OptionButton4 Then
        RZ(R, 1) = M(R, 1) ' оставляем исходный текст в родном столбце
    End If
    c = regexpmulti(M(R, 1)) ' Ищем совпадение по регулярке. Где "M(R, 1)" - это первый и единственный стоблец диапазона
    If OptionButton2 Then
        ' если групп захвата более ноля - удаляем весь текст вокруг оставляя тот который в скобках
        If ComboBox1.Text > 0 Then
        RZ(R, 1) = c(0) & c(1)
        Else
        RZ(R, 1) = c(1)
        End If
    End If
    If OptionButton3 Then
        RZ(R, 2) = c(0)
    End If
    If OptionButton1 Then
        RZ(R, 1) = c(1)
        RZ(R, 2) = c(0)
    End If
    If OptionButton4 Then
        RZ(R, 2) = c(1)
    End If
    Next R
    If CheckBox1.Value = True Then ' если чекбокс активен, переносим результат на новый лист
        Worksheets.Add ' создаем новый лист
        Range("A1").Resize(UBound(RZ), UBound(RZ, 2)) = RZ 'вставляем значения в первый столбец
    Else
        Range(S & "1").Resize(UBound(RZ), UBound(RZ, 2)) = RZ
    End If
    'авто высота\ширина столбцов\ячеек
    Cells.Columns.AutoFit
    Cells.Rows.AutoFit
    GoTo Skip ' пропускаем сообщение если ошибки нет
Error: ' в случае ошибки инициализируем предупреждение
    MsgBox "Неправильное регулярное выражение или неправильно количество групп захвата. А может какая-то непредвиденная ошибка", vbCritical, "Хьюстон, у нас проблемы =("
    GoTo 111 ' после ошибки не закрываем окно (Unload Me) а переступаем его, позволяя снова редактировать введенные данные
Skip:
    Unload Me
111:
End Sub

Private Sub Label2_Click()

End Sub

Private Sub OptionButton1_Click()
Label2.ForeColor = &H80000012 ' меняем цвет Label*
Label3.ForeColor = &H80000012
Label3.Caption = "Добавить:" ' надпись Label*
Label2.ControlTipText = "Группа захвата - выражение которое находится в скобках. Пример - '\s?\d{3}(Ваше значение)\s'. Отделяются только те значение которые указаны в скобках, остальное - удаляется."
Label3.ControlTipText = "Добавляет указанные символы в конце каждого совпадения." ' Подсказка
ComboBox1.Enabled = True
ComboBox1.BackColor = vbWindowBackground
TextBox2.Enabled = True
TextBox2.BackColor = vbWindowBackground
End Sub

Private Sub OptionButton2_Click()
Label2.ForeColor = &H80000012
Label3.ForeColor = &HFF&
Label3.Caption = "Заменить на:"
Label2.ControlTipText = "Группа захвата - выражение которое находится в скобках. Пример - '\s?\d{3}(Ваше значение)\s'. В случае если групп захвата более 0 - значения в скобках остаются, все остально удаляется."
Label3.ControlTipText = "Заменяет удаленные значения, на указанные символы."
ComboBox1.Enabled = True
ComboBox1.BackColor = vbWindowBackground
TextBox2.Enabled = True
TextBox2.BackColor = vbWindowBackground
End Sub

Private Sub OptionButton3_Click()
Label3.ForeColor = &H80000012
Label2.ForeColor = &H80000012
Label3.Caption = "Добавить:"
Label2.ControlTipText = "Группа захвата - выражение которое находится в скобках. Пример - '\s?\d{3}(Ваше значение)\s'. Отделяются только те значение которые указаны в скобках, остальное - удаляется."
Label3.ControlTipText = "Добавляет указанные символы в конце каждого совпадения."
ComboBox1.Enabled = True
ComboBox1.BackColor = vbWindowBackground
End Sub

Private Sub OptionButton4_Click()
Label3.ForeColor = &H80000000
Label2.ForeColor = &H80000000
Label2.ControlTipText = "В режиме удаление - поле отключено."
Label3.ControlTipText = "В режиме удаление - поле отключено."
ComboBox1.Enabled = False ' отключаем ComboBox
ComboBox1.BackColor = vbButtonFace ' меняем цвет
TextBox2.Enabled = False
TextBox2.BackColor = vbButtonFace
End Sub

Ссылка на рабочие скрипты: скачать.



Спасибо за внимание!