Добрый вечер, есть такой вопрос.
Я тут уже нашел макрос который мне нужен.
Он работает классно и так как надо, но такой вопрос.
Он берет фразы для поиска с другого листа, как его переделать, что нужно поменять, что бы он брал фразы для поиска с того же листа в котором и производит поиск?
Что бы он брал фразы из столбца B к примеру и уже делал поиск в столбце А как сейчас.
А и возможно ли сделать что бы он удалял ячейки а не строки?
Заранее спасибо всем кто откликнется)
Я тут уже нашел макрос который мне нужен.
Он работает классно и так как надо, но такой вопрос.
Он берет фразы для поиска с другого листа, как его переделать, что нужно поменять, что бы он брал фразы для поиска с того же листа в котором и производит поиск?
Что бы он брал фразы из столбца B к примеру и уже делал поиск в столбце А как сейчас.
А и возможно ли сделать что бы он удалял ячейки а не строки?
Заранее спасибо всем кто откликнется)
| Код |
|---|
Sub Del_Array_SubStr()
Dim sSubStr As String 'искомое слово или фраза
Dim lCol As Long 'номер столбца с просматриваемыми значениями
Dim lLastRow As Long, li As Long
Dim avArr, lr As Long
Dim arr
lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "Запрос параметра", 1))
If lCol = 0 Then Exit Sub
Application.ScreenUpdating = 0
lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
'заносим в массив значения листа, в котором необходимо удалить строки
arr = Cells(1, lCol).Resize(lLastRow).Value
'Получаем с Лист2 значения, которые надо удалить в активном листе
With Sheets("Лист2") 'Имя листа с диапазоном значений на удаление
avArr = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
'удаляем
Dim rr As Range
For lr = 1 To UBound(avArr, 1)
sSubStr = avArr(lr, 1)
For li = 1 To lLastRow 'цикл с первой строки до конца
If CStr(arr(li, 1)) = sSubStr Then
If rr Is Nothing Then
Set rr = Cells(li, 1)
Else
Set rr = Union(rr, Cells(li, 1))
End If
End If
DoEvents
Next li
DoEvents
Next lr
If Not rr Is Nothing Then rr.EntireRow.Delete
Application.ScreenUpdating = 1
End Sub
|
Изменено: - 03.06.2018 20:46:53
