На днях поступила задача обработать/нормализовать данные в таблице "лидов". После регистрации с разных веб-сайтов стекаются данные подписчиков в разном формате. Очень часто для упрощения регистрации посетителей просят ввести Ф.И.О в одной строке поля. И это значение хранится в структурированном виде как 1 строка из множества в таблицах. Вам нужно разделить по разделителю "пробел" значения строки разнеся их на разные столбцы для удобства обработки. В 90% случаев никто не вводит свое отчество (это абсолютно нормально), но эту подстроку тоже надо как-то вычислять. В общем, будем считать, что мы воспользовались сводкой данных в таблицу Excel, а через функцию на вкладке "Данные" -> "Текст по столбцам" разбили строку на подстроки, получив 3 столбца (Фамилия, Имя, Отчество). И вот мы подошли к сути этой небольшой статьи - порядок следования Фамилии и Имени в массе случаев просто нарушен, а маркетинг четко использует в рассылках обращение по имени. 

Нужно привести в порядок значения 2-х столбцов (Фамилия и Имя), а третий столбец с отчеством нас не волнует, т.к. никто его не использует в маркетинговых коммуникациях типа рассылок. Задача сводится к тому, чтобы перебрать значения столбца с именами (где их больше всего) и если там встретится что-то похожее на фамилию, то поменять местами со следующей ячейкой, т.к. там со 100% вероятностью будет Имя подписчика. Как правило, большинство фамилий имеют некий перечень окончаний, которые отсутствуют в имени, а значит дают нам право на идентификацию. Решение задачи было перенесено непосредственно в среду макросов Excel, т.к. таблица была именно в этом формате. 

Привожу листинг кода, код не оптимизирован, можно значительно его упростить и сделать универсальным, но конкретно эту задачу надо было решить оперативно.

Sub ChangeLeadsName()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("LEADS-Sheet")
      
    Dim cell As Range
    Dim arrEnds() As String
            arrEnds = Split("ов,ев,ич,ко,ак,ук,ян,ии", ",")
    Dim firstName, checkEnd As String
    Dim position, j, k As Integer
    ws.Activate
    k = 0
    For Each cell In Range("L2:L1844")  ' указываем диапазон обработки столбца с именами
        firstName = cell.Value
         For j = 0 To UBound(arrEnds)   ' перебираем окончания слова
          checkEnd = Right(firstName, 2)
          position = InStr(firstName, arrEnds(j))  ' необязательная функция поиска подстроки окончания в строке, но изначально она была одна

' Проверяем условие, что подстрока найдена, значение в ячейке есть, и 2 последних символа совпадают с нашим массивом окончаний
                If position > 0 And arrEnds(j) = checkEnd And Not IsEmpty(cell.Offset(0, 1).Value) Then
                    cell.Value = cell.Offset(0, 1).Value   ' смело записываем значение из соседней ячейки в анализируемую
                    cell.Offset(0, 1).Value = firstName  ' в соседнюю справа ячейку запишем анализируемую строку/ячейку
                    cell.Interior.Color = vbYellow    ' подсветим на листе ячейку где применили условие
                  k = k + 1  ' посчитаем, сколько раз сработало условие и выведем для информации ниже.
                End If
        Next j
    Next cell
  MsgBox "Всего под обработку попало: " & k & " записей из таблицы", , "Результат обработки"
End Sub

Итак, что ✔️ может функция этого макроса:

  1. Достаточно быстро (~1 секунда на 2000 записей) проанализировать и поменять ячейки местами.
  2. Отформатировать(окрасить) те ячейки таблицы, где макрос внес изменения для упрощения визуального контроля исполненной задачи.
  3. Можно пополнить массив окончаний для более продвинутого анализа.

А чего ❌не может макрос:

  1. Всякий раз нужно указывать размер анализируемого столбца (Range).
  2. Анализирует только 2 символа в окончании.

И напоследок такой момент: использование достаточно распространённого окончания "-ий" не будет корректно работать, т.к. множество имен также имеют такое же окончание "Валерий, Дмитрий, Василий" и т.д. Отдельно потребуется совершенствование алгоритма для женских фамилий (анализ окончания с 3-мя последними буквами, например).

В результате я больше потратил времени на написание этой статьи, чем на написание макроса и, я уверен, что приведенный код можно значительно сократить и улучшить! 

В любом случае придется вручную ячейки проверять и для тех значений, где нет условий описанного макроса, хорошо бы по сочетанию клавиш вызывать функцию обмена ("свопа") 2-х выделенных ячеек между собой. Для этого можно использовать такой макрос (нашел на просторах интернета, ссылку не помню):

Sub SwapTwoCells()
    Dim temp As Variant
    If Selection.Cells.Count = 2 Then
        With Selection
            temp = .Cells(1).Value ' Store the value of the first cell
            .Cells(1).Value = .Cells(2).Value ' Assign the value of the second cell to the first
            .Cells(2).Value = temp ' Assign the stored value to the second cell
        End With
    Else
        MsgBox "Please select exactly two cells to swap", vbCritical
    End If
End Sub

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

Удачной нормализации данных!