Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Выборочное удаление объектов с листа, кроме исключений.
 
#1
06.04.2018 21:55:35
Здравствуйте. Подскажите - как реализовать следующее:

Как макросом удалить все фигуры с листа, за исключением тех, что вписаны в диапазон J2:J9  ?
Раньше делал эту операцию через Ctrl+G, а потом аккуратно убирал выделение с тех фигур - которые не нужно удалять. Но это немного неудобно.
 
 
 
#2
06.04.2018 22:17:10
Если заменить имена автофигур на английские, то можно так
Код
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
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
06.04.2018 22:37:54
Еще вариант
Код
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
Согласие есть продукт при полном непротивлении сторон
 
 
 
#4
06.04.2018 22:53:41
Sanja, что-то не работает.
Почему-то не удаляет прямоугольник, которого нет в списке.
 
 
 
#5
07.04.2018 07:20:52
Код
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
Согласие есть продукт при полном непротивлении сторон
 
 
 
#6
07.04.2018 14:24:12
Sanja, спасибо.
 
 
 
Страницы: 1
Наверх