Здравствуйте. у меня есть список почтовых адресов нужно удалить строки (подчёркиваю всю строку) там где почта такого вида {любые цифры и дефис}в любом количестве@*
Можно как-то так. Выделяете диапазон с адресами (диапазон должен содержать не более 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
Пытливый, если я не ошибаюсь, то это условие Like "[0-9]*@*" говорит о том, что левая часть начинается с цифры, а не о том, что левая часть содержит только цифры или дефис
webley, да, совершенно верно. По условиям автора вопроса "любые цифры" С дефиса E-mail не начинается. А если нужно и такого вида удалять адреса: m056-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
oleg_dd, кстати, по поводу комп виснет я думаю, что при таком выделении Columns(16).Select будут поштучно обрабатываться не нужные 90т. строк, а все строки, т.е. больше 1млн. что на производительности скажется не лучшим образом...
Пытливый написал: Странно, конечно, что e-mail может начинаться с дефиса...
на самом деле он не может с него начинаться :-) но в задаче не было ничего про это сказано.
детальней проверил что писали выше IfSelection.Item(lngI) Like"[0-9]*@*"Then вот это удаляет всё что начинается с цифры, а не только цифры до собачки *** сообщение от webley великолепно подошло Благодарю