Каждый, кто работает с выгрузками из CRM, сайтов или 1С, знает эту боль. Вам падает файл на пару тысяч строк, а там... полная каша. У одного клиента телефон начинается с восьмерки, у другого с семерки, кто-то вообще умудрился вбить буквы. А текстовые ячейки из-за кривого импорта обросли скрытыми пробелами, которые намертво ломают любые формулы типа ВПР.
Обычно на ручную сортировку, замену символов и вылавливание дубликатов уходит весь вечер. Но зачем делать то, что компьютер может сделать за 10 секунд?
Сегодня я делюсь своим «секретным оружием» — готовым скриптом, который полностью автоматизирует этот ад.
Что конкретно делает этот инструмент:
- Ищет совпадения по всей строке: Если один и тот же человек отправил заявку трижды, скрипт мгновенно сотрет лишние строки.
- Убирает невидимый мусор: Стирает все лишние отступы до, внутри и после текста, возвращая ячейкам аккуратный вид.
- Приводит хаос к единому стандарту: Вырезает из номеров скобки, дефисы, случайные буквы и пересобирает их в идеальный формат +7 (ХХХ) ХХХ-ХХ-ХХ.
Скопируйте этот код:
vba
Sub ОчиститьДанныеИТелефоны()
Dim ws As Worksheet
Dim lastRow As Long, lastCol As Long, rngTable As Range
Dim i As Long, phoneCol As Long
Dim cellValue As String, cleanPhone As String, ch As String
Dim charIdx As Integer, j As Long
Set ws = ActiveSheet
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
Set rngTable = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol))
' 1. Уничтожаем полные дубликаты
Dim colArray() As Variant
ReDim colArray(0 To lastCol - 1)
For i = 0 To lastCol - 1: colArray(i) = i + 1: Next i
rngTable.RemoveDuplicates Columns:=(colArray), Header:=xlYes
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' 2. Умный поиск столбца с контактами
phoneCol = 0
For i = 1 To lastCol
Dim headerText As String
headerText = LCase(ws.Cells(1, i).Value)
If InStr(headerText, "тел") > 0 Or InStr(headerText, "phone") > 0 Then
phoneCol = i
Exit For
End If
Next i
If phoneCol = 0 Then phoneCol = 2
' 3. Глобальная чистка
For i = 2 To lastRow
For j = 1 To lastCol
If Not IsError(ws.Cells(i, j).Value) Then
ws.Cells(i, j).Value = Trim(Application.WorksheetFunction.Clean(ws.Cells(i, j).Value))
End If
Next j
cellValue = CStr(ws.Cells(i, phoneCol).Value)
cleanPhone = ""
For charIdx = 1 To Len(cellValue)
ch = Mid(cellValue, charIdx, 1)
If ch Like "[0-9]" Then cleanPhone = cleanPhone & ch
Next charIdx
If Len(cleanPhone) > 0 Then
If Len(cleanPhone) = 11 And Left(cleanPhone, 1) = "8" Then
cleanPhone = "7" & Mid(cleanPhone, 2)
ElseIf Len(cleanPhone) = 10 Then
cleanPhone = "7" & cleanPhone
End If
If Len(cleanPhone) = 11 And Left(cleanPhone, 1) = "7" Then
ws.Cells(i, phoneCol).Value = "+7 (" & Mid(cleanPhone, 2, 3) & ") " & _
Mid(cleanPhone, 5, 3) & "-" & _
Mid(cleanPhone, 8, 2) & "-" & _
Mid(cleanPhone, 10, 2)
Else
ws.Cells(i, phoneCol).Value = cleanPhone
End If
ws.Cells(i, phoneCol).NumberFormat = "@"
End If
Next i
MsgBox "Готово! База очищена за несколько секунд.", vbInformation, "Успех"
End Sub
Инструкция по запуску (справится даже новичок):
- Зайдите в ваш рабочий файл Excel.
- Зажмите комбинацию ALT + F11 (откроется техническое окно редактора).
- В верхнем меню кликните Insert -> Module и вставьте скопированный выше текст в белое поле.
- Закройте это окно, вернитесь к своей таблице, нажмите ALT + F8, выберите макрос и нажмите «Выполнить».
Фишка скрипта: Вам не нужно настраивать его под свои таблицы. Он сам найдет заголовок со словами «Телефон» или «Phone» и начнет форматирование именно там, не трогая другие важные цифры (например, артикулы или суммы).