| Код |
|---|
Sub Удаляем_множ_вхождения()
Dim sSubStr As String 'искомое слово или фраза
Dim lCol As Long
Dim lLastRow As Long, li As Long
Dim avArr, lr As Long
Dim arr
lCol = "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
'Получаем с Лист1 значения, которые надо удалить в активном листе
With Sheets("Лист1") 'Имя листа с диапазоном значений на удаление
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
|
я тоже пользовался данным макросом для удаления лишних строк в таблице (и пользуюсь до сих пор)
но возникла потребность не удалять, а перемещать (не копировать, а именно перемещать желательно не оставляя пустых строк) данные строки на другой лист (лист2 например) как это возможно реализовать? удаление буквально 1 строчкой прописано. Или создавать отдельную тему?
| Код |
|---|
If Not rr Is Nothing Then rr.EntireRow.Delete |
