Добрый день! В теме слукавил немного. Сравнить получилось, но... Макрос работает следующий:
[vba]
Код
Sub УдалениеЛистовПоПеречнюНаПервомЛисте() Dim i As Long, i1 As Long, shtCount As Integer, nesovpal As Long Dim sht As Worksheet Dim Name1sht() As String, shtName() As String i_n = Worksheets(1).Columns(15).Cells(Rows.Count, 1).End(xlUp).Row ReDim Name1sht(i_n) For i = 1 To i_n Name1sht(i) = Worksheets(1).Cells(i, 15) Next i shtCount = Worksheets.Count ReDim shtName(shtCount) For Each sht In ActiveWorkbook.Worksheets i1 = i1 + 1 shtName(i1) = sht.Name Next sht For i1 = 1 To shtCount sovpal = 0 For i = 1 To i_n If Name1sht(i) Like shtName(i1) = True Then MsgBox (Name1sht(i) & Chr(13) & shtName(i1)) sovpal = sovpal + 1 End If Next i If sovpal = 0 Then Application.DisplayAlerts = False Worksheets(shtName(i1)).Delete Application.DisplayAlerts = True End If Next i1 End Sub
[/vba]
Он удаляет все листы из книги, не находящиеся в перечне на первом листе (15 столбце). Изначально у меня вместо [vba]
Код
If Name1sht(i) Like shtName(i1) = True Then MsgBox (Name1sht(i) & Chr(13) & shtName(i1)) sovpal = sovpal + 1 End If
[/vba] было [vba]
Код
If Name1sht(i) = shtName(i1) Then MsgBox (Name1sht(i) & Chr(13) & shtName(i1)) sovpal = sovpal + 1 End If
[/vba] И вот изначально он не работал (удалял все листы, словно ни один элемент первого массива не равнялся ни единому элементу второго (что неправда). Может кто-нибудь пояснить, почему изначальный (нижний) вариант не работает?
Добрый день! В теме слукавил немного. Сравнить получилось, но... Макрос работает следующий:
[vba]
Код
Sub УдалениеЛистовПоПеречнюНаПервомЛисте() Dim i As Long, i1 As Long, shtCount As Integer, nesovpal As Long Dim sht As Worksheet Dim Name1sht() As String, shtName() As String i_n = Worksheets(1).Columns(15).Cells(Rows.Count, 1).End(xlUp).Row ReDim Name1sht(i_n) For i = 1 To i_n Name1sht(i) = Worksheets(1).Cells(i, 15) Next i shtCount = Worksheets.Count ReDim shtName(shtCount) For Each sht In ActiveWorkbook.Worksheets i1 = i1 + 1 shtName(i1) = sht.Name Next sht For i1 = 1 To shtCount sovpal = 0 For i = 1 To i_n If Name1sht(i) Like shtName(i1) = True Then MsgBox (Name1sht(i) & Chr(13) & shtName(i1)) sovpal = sovpal + 1 End If Next i If sovpal = 0 Then Application.DisplayAlerts = False Worksheets(shtName(i1)).Delete Application.DisplayAlerts = True End If Next i1 End Sub
[/vba]
Он удаляет все листы из книги, не находящиеся в перечне на первом листе (15 столбце). Изначально у меня вместо [vba]
Код
If Name1sht(i) Like shtName(i1) = True Then MsgBox (Name1sht(i) & Chr(13) & shtName(i1)) sovpal = sovpal + 1 End If
[/vba] было [vba]
Код
If Name1sht(i) = shtName(i1) Then MsgBox (Name1sht(i) & Chr(13) & shtName(i1)) sovpal = sovpal + 1 End If
[/vba] И вот изначально он не работал (удалял все листы, словно ни один элемент первого массива не равнялся ни единому элементу второго (что неправда). Может кто-нибудь пояснить, почему изначальный (нижний) вариант не работает?Roman777
Много чего не знаю!!!!
Сообщение отредактировал Roman777 - Пятница, 15.05.2015, 14:35
И не будет работать. У вас несколько открытых книг, обращение к листам у вас , подразумевается , к активной книге. [vba]
Код
'Вместо If Name1sht(i) Like shtName(i1) = True Then ' Должно быть If (Name1sht(i) Like shtName(i1)) = True Then
Sub УдалениеЛистовПоПеречнюНаПервомЛисте() Dim i As Long, i1 As Long, shtCount As Integer Dim sht As Worksheet Dim Name1sht As Object, Key As String Set Name1sht = CreateObject("scripting.dictionary") i_n = ThisWorkbook.Worksheets(1).Columns(15).Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To i_n Key = Worksheets(1).Cells(i, 15) Name1sht.Item(Key) = Key Next i shtCount = Worksheets.Count Application.DisplayAlerts = False For Each sht In ActiveWorkbook.Worksheets Key = sht.Name If Name1sht.Exists(Key) Then sht.Delete End If Next sht Application.DisplayAlerts = True
И не будет работать. У вас несколько открытых книг, обращение к листам у вас , подразумевается , к активной книге. [vba]
Код
'Вместо If Name1sht(i) Like shtName(i1) = True Then ' Должно быть If (Name1sht(i) Like shtName(i1)) = True Then
Sub УдалениеЛистовПоПеречнюНаПервомЛисте() Dim i As Long, i1 As Long, shtCount As Integer Dim sht As Worksheet Dim Name1sht As Object, Key As String Set Name1sht = CreateObject("scripting.dictionary") i_n = ThisWorkbook.Worksheets(1).Columns(15).Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To i_n Key = Worksheets(1).Cells(i, 15) Name1sht.Item(Key) = Key Next i shtCount = Worksheets.Count Application.DisplayAlerts = False For Each sht In ActiveWorkbook.Worksheets Key = sht.Name If Name1sht.Exists(Key) Then sht.Delete End If Next sht Application.DisplayAlerts = True
doober, или я сейчас Вас не понял, или Вы меня не поняли. У меня макрос работает (книга открыта одна, собственно даже если не 1, запускаю то я в нужной книге). Не работает изначальный вариант макроса, когда вместо: [vba]
Код
If Name1sht(i) Like shtName(i1) = True Then MsgBox (Name1sht(i) & Chr(13) & shtName(i1)) sovpal = sovpal + 1 End If
[/vba] написано было: [vba]
Код
If Name1sht(i) = shtName(i1) Then MsgBox (Name1sht(i) & Chr(13) & shtName(i1)) sovpal = sovpal + 1 End If
[/vba] И вот тут я разницы не понял, почему же в нижнем варианте не работает, а в верхнем работает. Ваш вариант, судя по всему, тоже самое что и у меня в конечном варианте, просто выполнен через словарь, я правильно понял?
doober, или я сейчас Вас не понял, или Вы меня не поняли. У меня макрос работает (книга открыта одна, собственно даже если не 1, запускаю то я в нужной книге). Не работает изначальный вариант макроса, когда вместо: [vba]
Код
If Name1sht(i) Like shtName(i1) = True Then MsgBox (Name1sht(i) & Chr(13) & shtName(i1)) sovpal = sovpal + 1 End If
[/vba] написано было: [vba]
Код
If Name1sht(i) = shtName(i1) Then MsgBox (Name1sht(i) & Chr(13) & shtName(i1)) sovpal = sovpal + 1 End If
[/vba] И вот тут я разницы не понял, почему же в нижнем варианте не работает, а в верхнем работает. Ваш вариант, судя по всему, тоже самое что и у меня в конечном варианте, просто выполнен через словарь, я правильно понял?Roman777
Sub УдалениеЛистовПоПеречнюНаПервомЛисте() Dim i As Long Dim sht As Worksheet Dim Key As String With ThisWorkbook.Worksheets(1).Columns(15) a = Range(.Cells(1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row)).Value End With Application.DisplayAlerts = False For Each sht In ActiveWorkbook.Worksheets Key = sht.Name For i = 1 To UBound(a) If Key = a(i, 1) Then sht.Delete: Exit For Next Next sht Application.DisplayAlerts = True
End Sub
[/vba] упс, перепутал - удаляет по списку. Переделаю попозже... Вот: [vba]
Код
Sub УдалениеЛистовНеВПеречнеНаПервомЛисте() Dim i As Long Dim sht As Worksheet Dim Key As String Dim col As New Collection Dim el
With ThisWorkbook.Worksheets(1).Columns(15) a = Range(.Cells(1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row)).Value End With
For Each sht In ActiveWorkbook.Worksheets Key = sht.Name col.Add Key For i = 1 To UBound(a) If Key = a(i, 1) Then col.Remove col.Count: Exit For Next Next sht Application.DisplayAlerts = False For Each el In col: Sheets(el).Delete: Next Application.DisplayAlerts = True
End Sub
[/vba]
Я пока такой вариант написал, без словаря: [vba]
Код
Sub УдалениеЛистовПоПеречнюНаПервомЛисте() Dim i As Long Dim sht As Worksheet Dim Key As String With ThisWorkbook.Worksheets(1).Columns(15) a = Range(.Cells(1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row)).Value End With Application.DisplayAlerts = False For Each sht In ActiveWorkbook.Worksheets Key = sht.Name For i = 1 To UBound(a) If Key = a(i, 1) Then sht.Delete: Exit For Next Next sht Application.DisplayAlerts = True
End Sub
[/vba] упс, перепутал - удаляет по списку. Переделаю попозже... Вот: [vba]
Код
Sub УдалениеЛистовНеВПеречнеНаПервомЛисте() Dim i As Long Dim sht As Worksheet Dim Key As String Dim col As New Collection Dim el
With ThisWorkbook.Worksheets(1).Columns(15) a = Range(.Cells(1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row)).Value End With
For Each sht In ActiveWorkbook.Worksheets Key = sht.Name col.Add Key For i = 1 To UBound(a) If Key = a(i, 1) Then col.Remove col.Count: Exit For Next Next sht Application.DisplayAlerts = False For Each el In col: Sheets(el).Delete: Next Application.DisplayAlerts = True
Я нашёл у себя опечатку , странно что она так повлияла [vba]
Код
Dim i As Long, i1 As Long, shtCount As Integer, nesovpal As Long
[/vba] у меня используется переменная "sovpal", а не "nesovpal", после исправления в данной строке "nesovpal" на "sovpal", макрос отработал корректно.
Я нашёл у себя опечатку , странно что она так повлияла [vba]
Код
Dim i As Long, i1 As Long, shtCount As Integer, nesovpal As Long
[/vba] у меня используется переменная "sovpal", а не "nesovpal", после исправления в данной строке "nesovpal" на "sovpal", макрос отработал корректно.Roman777
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
, странно что она так повлияла 
