Страницы: 1
RSS
удаление листов из книги вне списка/столбца значений макрос
 
Доброго всем.
Подскажите где тут ошибка (пытаюсь перекрутить ранее подсказанный добрыми ребятами с этого форума под новые нужды) и как ее можно исправить чтобы по заданным наименованиям в столбце 7 начиная с сell(1,7)  и до последней ячейки в столбце названия Сравнивались с текущими названиями листов в книге И Удалялись если не совпадают.
Код
   iLastRow = Cells(3, 7).End(xlDown).Row ' последняя заполненная ячейка в столбце с именами листов
  For i = 1 To iLastRow
  If a = Worksheets("check").Cells(i, 7).Value Then
 For Each Worksheet In ThisWorkbook.Sheets 
      
     If a <> Worksheet.Name Then
     

        
        Worksheet.Delete
        End If
        On Error Resume Next
    Next
    
    i = i + 1
    End If
        On Error Resume Next
    Next
Спасибо за время и добрые советы.
 
Уххх сложно было, нон оно работает ^_^= ловите, может кому сгодиться. ;)
Код
Dim s As Object, a As Variant, z As Integer, d As Boolean, zojberg As Variant   
    a = WorksheetFunction.Transpose(Worksheets("check").Range(Worksheets("check").Cells(1, 7), Worksheets("check").Cells(iLastRow, 7)))
    
        Application.DisplayAlerts = False
    For Each s In Sheets
        d = True
        For z = LBound(a) To UBound(a)
            If s.Name = a(z) Then d = False
        Next z
        If d Then s.Delete
    Next s
    Application.DisplayAlerts = True
Изменено: Tesla_LOLa - 18.02.2019 19:34:31
 
просто: из списка собрать словарь dicSheets (в ключи - sh.Names списка),
потом цикл For Each sh in Thisworkbook.Sheets.. по листам ! с проверкой в словаре:
If Not dicSheets.exists(sh.Name) Then sh.Delete
-- примеров работы со словарями много на форуме -- CreateObject("Scripting.Dictionary")
как-то так - более оптимально...
а то вы в цикле на каждом листе заново запускаете цикл на просмотр массива - снова и снова...
а при использовании словаря - будет только цикл по листам и проверка по ключу (сразу видит есть ли этот ключ-лист в "списке", т.е. в словаре ! созданном из списка)...
успехов
Изменено: JeyCi - 19.02.2019 08:43:55
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
Цитата
JeyCi написал:
просто: из списка собрать словарь dicSheets (в ключи - sh.Names списка),потом цикл For Each sh in Thisworkbook.Sheets.. по листам ! с проверкой в словаре:If Not dicSheets.exists(sh.Name) Then sh.Delete
Подскажите пожалуйста как это будет выглядеть в коде целиком, просто я пока только стараюсь учиться и далеко не все так легко с ходу могу понять что к чему........словари для меня тайная комната......... :)  
 
Цитата
Tesla_LOLa написал:
я пока только стараюсь учиться
научитесь читать правила форума - в части "приложить файл"
Цитата
Tesla_LOLa написал:
не все так легко с ходу могу понять что к чему........
поиск по форуму! И свои попытки - чтобы были понятны ваши затруднения... 2 раза не пишу  ;) о том, что примеров по словарям много... а так смахивает на "сделайте за меня"
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
Цитата
JeyCi написал:
"сделайте за меня"
даже это для меня не совсем понятно......
Код
Set d = CreateObject("Scripting.Dictionary"): d.comparemode = 1    
 ......................
     d.item(t) =  .Cells(i, 7) & "|" & .Cells(i, 7)  

про такие вещи как  :
Скрытый текст
просто не понятны еще такие конструкции - понять не могу как формируются, материала Очень много но пока до него не совсем дорос, только блуждаю по мелководью да присматриваюсь. мне бы примеры- чем проще и тупее (совсем для новичков) с описанием - может и сам чего то да сподобился........когда мастодонты описывают макросы с использованием нескольких словарей в сложных макросах у меня честно глаза выползают из орбит и мозг лопается...... если не трудно поясните немного механизм формирования и работы со словарями на простых примерах (на Любых- чем проще тем лучше) пока въехать не могу......
 
Tesla_LOLa, здравствуйте! Попробую себя в роли учителя…

Задача разбивается на две подзадачи: получение списка "разрешённых" листов и удаление "неразрешённых" листов. В таком случае, возможно, имеете смысл обойтись без первого шага с формированием списка и сразу перейти к удалению листов в цикле по критерию (тому же, который бы служил для создания списка "разрешённых").

Что я имею ввиду: допустим, вам нужно ОСТАВИТЬ только те листы, название которых начинается на "ОСТАВИТЬ_". Вместо того, чтобы формировать список по этому критерию, можно сразу устроить цикл с проверкой по критерию.

НО В данном случае никаких догадок я делать не буду и рассматриваем "как есть", поэтому вот вам 2 макроса (простой и сложный) с комментариями:
КОД
спрашивайте, что непонятно  ;)

Ссылки:
Последняя ячейка на листе
InStr (можно и Like)
Массивы
Словари (тут не использованы)
Изменено: Jack Famous - 19.02.2019 18:03:53
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
Попробую себя в роли учителя…
Спасибо Огромное и низкий поклон за науку= у Вас прирожденный талант педагога, теперь хоть стало немного понятнее. ;)  :idea:  
 
Вариант с коллекцией (хотя как по мне так словари удобней)  ;)
Скрытый текст
Изменено: Nordheim - 19.02.2019 22:09:52
"Все гениальное просто, а все простое гениально!!!"
 
Tesla_LOLa, c использованием ПОИСКПОЗ
Код
Sub DelSheets()
Dim sh As Object
  Application.DisplayAlerts = False
  For Each sh In Sheets
    If IsError(Application.Match(sh.Name, Worksheets("check").Columns(7), 0)) Then sh.Delete
  Next
  Application.DisplayAlerts = True
End Sub
Изменено: Казанский - 20.02.2019 00:07:17
 
Мои пять копеек:
Скрытый текст
 
Еще вариант без коллекций и словарей  :D
Скрытый текст
"Все гениальное просто, а все простое гениально!!!"
 

все коды не смотрела - просто по названию топика:

Код
Sub TEST()
With Application: .ScreenUpdating = False: .EnableEvents = False: .DisplayAlerts = False: .Calculation = xlManual: End With    
a = ThisWorkbook.Sheets("Лист1").Range("A1").CurrentRegion.Value
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1    ' если в массиве только числа, то можно без этой строки
    
    For i = 1 To UBound(a, 1)
        dic.Add a(i, 1), 0&
    Next i
    
    With dic
        For Each sh In ThisWorkbook.Sheets
            If Not .exists(CStr(sh.Name)) Then
                Debug.Print sh.Name
                sh.Delete
            End If
        Next sh
    End With
With Application: .ScreenUpdating = True: .EnableEvents = True: .DisplayAlerts = True: .Calculation = xlAutomatic: End With
End Sub

Изменено: JeyCi - 20.02.2019 09:06:13
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
Цитата
Tesla_LOLa написал: мне бы примеры-
повторюсь: поиск на форуме работает   8) -  не стесняйтесь ему формулировать свои хотелки... и адаптировать ответы под свои нюансы...
"Чтобы запрограммировать что-либо - надо знать логическую последовательность шагов, которую хотите закодировать!!"... а чтобы её выразить на языке (это уже др. задача) - воспользуйтесь документацией по синтаксису языка (любая справка)... все программисты так учатся при появлении каждого нового языка... -- не обязательно знать язык, чтобы начать писать код... -  знайте Что хотите писать, и подсматривайте синтаксис в справке(поиске/форуме) по языку... опыт нарабатывается практикой!
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
Tesla_LOLa, спасибо и вам  :)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Ребят спасибо Вам всем Огроменное= Вы Лучшие!!! :)  
 
Ну, "до кучи", еще вариант:
Код
Sub DelSheets()
    Dim ws As Worksheet: Application.DisplayAlerts = False
    For Each ws In Sheets
        If Sheets("check").Columns(7).Find(ws.Name, LookAt:=xlWhole) Is Nothing Then ws.Delete
    Next
End Sub
Чем шире угол зрения, тем он тупее.
 
SAS888, быстро и просто  :idea:
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Страницы: 1
Наверх