Страницы: 1
RSS
поиск и удаление определённых почтовых адресов (только цифровые значения)
 
Здравствуйте.
у меня есть список почтовых адресов
нужно удалить строки (подчёркиваю всю строку) там где почта такого вида
{любые цифры и дефис}в любом количестве@*

в файле отметил, 296-1543@homestead.com 5144@costellosace.com 7504@costellosace.com
эти все должны удалиться

нужен макрос
вот нашел интересный пример, но там ищет чёткое совпадение текста, а не подстановочными символами
http://excelvba.ru/code/ConditionalRowsDeleting
 
Цитата
oleg_dd написал: в файле отметил,
и Хгде этот файл?
 
Можно как-то так. Выделяете диапазон с адресами (диапазон должен содержать не более 1 столбца) и запускаете макрос
Код
Sub oleg_dd()
Dim lngI As Long
    If Selection.Columns.Count > 1 Then
        MsgBox "В выделении должно быть не более одного столбца"
        Exit Sub
    End If
    For lngI = Selection.Rows.Count To 1 Step -1
        If Selection.Item(lngI) Like "[0-9]*@*" Then
            Selection.Item(lngI).EntireRow.Delete shift:=xlUp
        End If
    Next lngI
End Sub
Кому решение нужно - тот пример и рисует.
 
можно при помощи udf пометить строки на удаление, а потом удалить руками:
Код
Public Function udfNumInEmail(Email As String) As Boolean
    Dim n As Integer
    If InStr(1, Email, "@") <> 0 Then
        For n = 0 To 9
            Email = Replace(Email, n, "")
        Next n
        Email = Replace(Email, "-", "")
        udfNumInEmail = IIf(Left(Email, 1) = "@", True, False)
    Else
        udfNumInEmail = CVErr(xlErrValue)
    End If
End Function
 
Цитата
oleg_dd написал: ... вот нашел интересный пример, но там...
off
Так почему бы вам на том сайте к автору и не обратиться? А то некрасиво получается, однако... ;)
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
Пытливый, если я не ошибаюсь, то это условие Like "[0-9]*@*" говорит о том, что левая часть начинается с цифры, а не о том, что левая часть содержит только цифры или дефис
 
вот это да, забыл файл прикрепить.
сейчас попробую сразу варианты и отпишусь

всё хорошо, для себя сделал
Columns(16).Select
для выделения нужного мне столбца и удалил проверку на выделение
Изменено: oleg_dd - 31.03.2015 23:02:00
 
webley, да, совершенно верно.
По условиям автора вопроса "любые цифры"
С дефиса E-mail не начинается.
А если нужно и такого вида удалять адреса: m056-783Z@email.gov
то пусть ТС об этом скажет... :)
Кому решение нужно - тот пример и рисует.
 
я так понял, что как раз не надо удалять адреса вида 056m-783Z@email.gov
но тут автору виднее...
 
"С дефиса E-mail не начинается. " он может начинаться с дефиса, а может нет. в условии любые цифры и дефис в любых комбинациях
но если есть хоть одна буква - это уже не нужно,
вот только у меня комп виснет когда запускаю на рабочем файле :-( там 90000 строк
 
ну, тогда я, наверное, неправильно задание понял.
Странно, конечно, что e-mail может начинаться с дефиса...
Если такой вариант исключить, то может вот такое сгодится?
Код
Sub oleg_dd()
Dim lngI As Long
Dim strS As String
    If Selection.Columns.Count > 1 Then
        MsgBox "В выделении должно быть не более одного столбца"
        Exit Sub
    End If
    For lngI = Selection.Rows.Count To 1 Step -1
        strS = Trim(Selection.Item(lngI))
            If Not Left(strS, InStr(1, strS, "@") - 1) Like "*[0-9][a-z]*" And _
            Not Left(strS, InStr(1, strS, "@") - 1) Like "[a-z]*" Then
        '    Selection.Item(lngI).Interior.Color = vbRed
                    Selection.Item(lngI).EntireRow.Delete shift:=xlUp
            End If
    Next lngI
End Sub
Кому решение нужно - тот пример и рисует.
 
а я пожалуй закончу свою мысль:
Код
Sub EmailDel()
    Dim r As Long
    Application.ScreenUpdating = False
    For r = Cells(Rows.Count, 16).End(xlUp).Row To 1 Step -1
        If udfNumInEmail(Cells(r, 16)) Then Rows(r).Delete
    Next r
    Application.ScreenUpdating = True
End Sub

Public Function udfNumInEmail(Email As String) As Boolean
    Dim n As Integer
    If InStr(1, Email, "@") <> 0 Then
        For n = 0 To 9
            Email = Replace(Email, n, "")
        Next n
        Email = Replace(Email, "-", "")
        udfNumInEmail = IIf(Left(Email, 1) = "@", True, False)
    Else
        udfNumInEmail = False
    End If
End Function
Изменено: webley - 27.03.2015 18:04:31
 
oleg_dd, кстати, по поводу комп виснет
я думаю, что при таком выделении Columns(16).Select будут поштучно обрабатываться не нужные 90т. строк, а все строки, т.е. больше 1млн.
что на производительности скажется не лучшим образом...
 
Цитата
Пытливый написал: Странно, конечно, что e-mail может начинаться с дефиса...
на самом деле он не может с него начинаться :-)
но в задаче не было ничего про это сказано.

детальней проверил что писали выше
IfSelection.Item(lngI) Like"[0-9]*@*"Then
вот это удаляет всё что начинается с цифры, а не только цифры до собачки
***
сообщение от  webley великолепно подошло
Благодарю
Изменено: oleg_dd - 31.03.2015 23:02:35
Страницы: 1
Наверх