Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Выборочное удаление объектов с листа, кроме исключений.
 
Здравствуйте. Подскажите - как реализовать следующее:

Как макросом удалить все фигуры с листа, за исключением тех, что вписаны в диапазон J2:J9  ?
Раньше делал эту операцию через Ctrl+G, а потом аккуратно убирал выделение с тех фигур - которые не нужно удалять. Но это немного неудобно.
 
Если заменить имена автофигур на английские, то можно так
Код
Sub DelShp()
Dim iShp As Shape, I&, iTemp
Dim dic As Object
With Worksheets("Лист3")
    arr = .Range("J2:J" & .Cells(.Rows.Count, "J").End(xlUp).Row).Value
End With
Set dic = CreateObject("Scripting.Dictionary")
For I = 1 To UBound(arr)
    iTemp = dic(CStr(arr(I, 1)))
Next
For Each iShp In Worksheets("Лист3").Shapes
    If Not dic.Exists(iShp.Name) Then iShp.Delete
Next
End Sub
Согласие есть продукт при полном непротивлении сторон.
 
Еще вариант
Код
Sub DelShp()
Dim iShp As Shape, iCell As Range
For Each iShp In Worksheets("Лист3").Shapes
    Set iCell = Worksheets("Лист3").Columns("J").Find(iShp.Name)
    If iCell Is Nothing Then iShp.Delete
Next
End Sub
Согласие есть продукт при полном непротивлении сторон.
 
Sanja, что-то не работает.
Почему-то не удаляет прямоугольник, которого нет в списке.
 
Код
Sub DelShp1()
Dim iShp As Shape, iCell As Range
For Each iShp In Worksheets("Ëèñò3").Shapes
    Set iCell = Worksheets("Ëèñò3").Columns("J").Find(iShp.Name, , , xlWhole)
    If iCell Is Nothing Then iShp.Delete
Next
End Sub
Согласие есть продукт при полном непротивлении сторон.
 
Sanja, спасибо.
Страницы: 1
Читают тему (гостей: 1)
Наверх