AndVGri
Advanced Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Процедура работает с активной книгой в которой находятся: лист с таблицей, содержащей строки для удаления, и лист с номерами для удаления
Код:
Public Sub KillNeedRow()
On Error GoTo errHandle
Dim shSource As Worksheet, shNeed As Worksheet
Dim rSource As Range, rNeed As Range
Dim curNeed As Range, delRange As Range, pFind As Range
Dim firstAddress As String
Application.ScreenUpdating = False
'лист, содержащий таблицу со строками для удаления
Set shSource = ActiveWorkbook.Worksheets("Лист1")
'лист, содержащий номера для удаления
Set shNeed = ActiveWorkbook.Worksheets("Лист2")
Set rSource = Application.Intersect(shSource.UsedRange, shSource.Columns("C"))
Set rNeed = shNeed.UsedRange
If rSource Is Nothing Then Exit Sub
If rNeed Is Nothing Then Exit Sub
For Each curNeed In rNeed
Set pFind = rSource.Find(curNeed.Value, rSource.Cells(1), xlValues, XlLookAt.xlWhole)
If Not pFind Is Nothing Then
If delRange Is Nothing Then Set delRange = shSource.Rows(pFind.Row)
firstAddress = pFind.Address
Do
Set pFind = rSource.FindNext(pFind)
Set delRange = Application.Union(delRange, shSource.Rows(pFind.Row))
Loop Until firstAddress = pFind.Address
End If
Next curNeed
If Not delRange Is Nothing Then delRange.Delete XlDeleteShiftDirection.xlShiftUp
Application.ScreenUpdating = True
Exit Sub
errHandle:
Application.ScreenUpdating = True
MsgBox Err.Description, vbOKOnly + vbExclamation, Err.Source
End Sub
|
|
Всего записей: 750 | Зарегистр. 14-12-2005 | Отправлено: 05:12 22-10-2010 | Исправлено: AndVGri, 05:28 22-10-2010 |
|
