Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Удалить листы в книге, кроме активного и из списка
 
#1
20.01.2020 17:52:56
Например: нужно оставить активный лист и листы с именем 1 и 2(или другими из списка) ,- остальные удаляем. Думаю, здесь не нужен пример.спасибо.
Изменено: Советник I категории - 20.01.2020 18:32:17
 
 
 
#2
20.01.2020 18:00:14
А много там в списке листов?

P.S. Ну да, пример нужен. Без проверки накосячил в коде.
Код
Option Explicit

Sub PrimerVseTakiNujen()
    Dim shX As Worksheet
    
    Application.DisplayAlerts = False
    
    For Each shX In ThisWorkbook.Worksheets
        If shX.Name <> ThisWorkbook.ActiveSheet.Name And shX.Name <> "Ëèñò 2" And shX.Name <> "Ëèñò 1" Then
            shX.Delete
        End If
    Next shX
    
    Application.DisplayAlerts = True
    
End Sub
Изменено: Wiss - 20.01.2020 18:05:24
Я не волшебник, я только учусь.
 
 
 
#3
20.01.2020 19:23:24
вот пример.  Также, если кто знает, такой вариант: активный лист оставляем, а все что правее до последнего листа в книге удоляем. т.е. всё, что между активным листом и последним нужно удалить. помогите, пожалуйста!
Изменено: Советник I категории - 20.01.2020 19:25:53
 
 
 
#4
20.01.2020 19:49:55
Доброе время суток.
Цитата
Советник I категории написал:
такой вариант: активный лист оставляем, а все что правее до последнего листа в книге удоляем
:D
Код
Public Sub DeleteRightSheets()
    Dim aSheet As Object, Ids() As Long, i As Long
    Set aSheet = ActiveWorkbook.ActiveSheet
    If aSheet.Index < ActiveWorkbook.Sheets.Count Then
        ReDim Ids(1 To ActiveWorkbook.Sheets.Count - aSheet.Index)
        For i = aSheet.Index + 1 To ActiveWorkbook.Sheets.Count
            Ids(i - aSheet.Index) = i
        Next
        Application.DisplayAlerts = False
        ActiveWorkbook.Sheets(Ids).Delete
        Application.DisplayAlerts = True
    End If
End Sub
 
 
 
#5
20.01.2020 20:18:05
Андрей VG, удаляет вместе с последним листом,- он нужен.
 
 
 
#6
20.01.2020 20:24:23
Цитата
Советник I категории написал:
удаляет вместе с последним листом,- он нужен.
Ну, да, приношу свои извинения воспринял до, как по. Будьте столь любезны, подправьте условие выполнения и верхнюю границу цикла записи индексов удаляемых листов в массив.
Изменено: Андрей VG - 20.01.2020 20:24:55 (ошибки-с)
 
 
 
#7
20.01.2020 20:39:34
я не умею это делать, если Вы успели заметить из моего обращения на сайт.

Wiss, Ваш код рабочий,- там ничего править не нужно, спасибо.
 
 
 
#8
20.01.2020 21:14:59
Цитата
Советник I категории написал:
я не умею это делать, если Вы успели заметить из моего обращения на сайт.
А каким образом это можно было заметить?
Нет фразы "Прошу написать макрос..", но есть
Цитата
Советник I категории написал:
Думаю, здесь не нужен пример
Хотя для простоты можно было приложить файл, где, например, зелёным помечен активный лист, красным для удаления и белым - которые нужно оставить.
Мой вывод - начинающий программист, плохо знающий объектную модель Excel. :)
 
 
 
#9
20.01.2020 21:22:02
Цитата
Андрей VG написал:
зелёным помечен активный лист, красным для удаления и белым - которые нужно оставить.
я думаю что Вам бы это врядли помогло, если Вы букв не видите в тз.Где я ПРОДУБЛИРОВАЛ условие: " т.е. всё, что между активным листом и последним нужно удалить".

Цитата
Андрей VG написал: Мой вывод
я рад за вас, что вы такой наблюдательный,- жижнь удалась у вас наверное,- я рад за таких как ты, Вы. Прям день у тебя у Вас задался сегодня, можно ложиться спать спокойно. от своего величия.  
Изменено: Советник I категории - 20.01.2020 23:23:44
 
 
 
#10
20.01.2020 21:26:39
Цитата
Советник I категории написал:
думаю что Вам бы это врядли помогло, если Вы букв не видите.
ну, по сравнению с вашим названием темы - это не такой и смертельный порок, но файл пример бы помог, не сомневайтесь :)
 
 
 
#11
20.01.2020 21:33:41
ПРИМЕР.
 
 
 
#12
20.01.2020 22:05:10
Щелкаем левой кнопкой мыши по ярлычку первого листа, который надо удалить. Затем, если надо выполнить какую-нибудь операцию (н-р, удалить) над группой подряд идущих (т.н. смежных) листов, то, удерживая нажатой клавишу Shift, щелкаем по ярлычку последнего листа из группы. Если надо добавить в группу (или исключить из выделенного) отдельные (несмежные) листы, то помечаем их, удерживая нажатой клавишу Ctrl. Далее, правой кнопкой мыши на ярлычке одного из выделенных листов вызываем контекстное меню, выбираем Удалить, подтверждаем удаление в диалоговом окне (если на выделенных листах есть данные), и -- вуаля! Если листов слишком много, можно воспользоваться кнопками прокрутки, расположенными слева от ярлычков.
Удачи!  
 
 
 
#13
20.01.2020 22:31:15
Код
Public Sub DeleteRightSheets()
    Dim aSheet As Object, Ids() As Long, i As Long
    Set aSheet = ActiveWorkbook.ActiveSheet
    If aSheet.Index < ActiveWorkbook.Sheets.Count - 1 Then
        ReDim Ids(1 To ActiveWorkbook.Sheets.Count - aSheet.Index - 1)
        For i = aSheet.Index + 1 To ActiveWorkbook.Sheets.Count - 1
            Ids(i - aSheet.Index) = i
        Next
        Application.DisplayAlerts = False
        ActiveWorkbook.Sheets(Ids).Delete
        Application.DisplayAlerts = True
    End If
End Sub

Цитата
Советник I категории написал:
всё, что между активным листом и последним нужно удалить".  
вот так бы и с самого начала :)
Цитата
Советник I категории написал:
можно ложиться спать спокойно
да, в какой мере.
Просите и дано будет...
Изменено: Андрей VG - 20.01.2020 22:32:14
 
 
 
#14
21.01.2020 03:38:17
Цитата
esheg написал:
Щелкаем левой кнопкой мыши
я уже так нащелкался в процессе работы, что
Цитата
esheg написал:
удерживая нажатой клавишу Shift,
стал ненавидеть эту клавишу..
Цитата
esheg написал:
подтверждаем удаление в диалоговом окне
и нервная система не готова смотреть на эти окна.
Цитата
esheg написал:
Удачи!  
это Вам удачи в нелегком труде. и крепких нервов.
Хотя у меня на работе есть люди, которые боятся макросов и говорят, что вдруг разучатся щелкать.
 
 
 
#15
21.01.2020 03:44:20
Спасибо Андрей VG,
Цитата
Андрей VG написал:
Просите и дано будет...
..ищите, и найдете; стучите, и отворят вам. Аминь.
Изменено: Советник I категории - 21.01.2020 10:22:33
 
 
 
Страницы: 1
Наверх