Страницы: 1
RSS
Очистка ячейки если имя листа равно значению
 
Добрый день!
Я в vba не силен. Пытаюсь решить задачу очистки данных ячеек в книге если имя листа равно определенному значению. Написал код, но не на всех листах работает.
Предполагаю, что дело в этой строке: ElseIf Sheets(StartList).Name = Left(Sheets(StartList).Name, 3) = "ВО1" Then
Можно данную процедуру написать иначе?
Код
Sub NumeraciyDelet()

    Dim ListiVse As Long
    Dim Name As Variant
    Dim a As Integer                               'Счетчик
    Dim StartList As Long
    
    Dim Sheet As Variant
    
    ListiVse = Worksheets.Count
    StartList = 1
    
        For a = 1 To ListiVse
        
            Sheet = Left(Sheets(StartList).Name, 3)
        
              If Sheets(StartList).Name = "Титул" Then
                 Worksheets(StartList).Range("DA31:DF31").ClearContents                                     'Удалить нумерацию на титуле
                 
                 ElseIf Sheets(StartList).Name = Left(Sheets(StartList).Name, 3) = "ВО1" Then
                    Worksheets(StartList).Range("AY243:BA243").ClearContents                                'Удалить нумерацию на ВО1
                    
                    ElseIf Sheets(StartList).Name = Left(Sheets(StartList).Name, 2) = "ВО" Then
                       Worksheets(StartList).Range("AZ254:BA254").ClearContents                             'Удалить нумерацию на ВО
                    
                       'ElseIf Sheets(StartList).Name = Left(Sheets(StartList).Name, 3) = "МК1" Then
                          ElseIf Sheet = "МК1" Then
                          Worksheets(StartList).Range("SkvNum1").ClearContents                              'Удалить нумерацию МК1
                          
                          ElseIf Sheets(StartList).Name = Left(Sheets(StartList).Name, 2) = "МК" Then
                             Worksheets(StartList).Range("SkvNum2").ClearContents                           'Удалить нумерацию МК
                             
                             ElseIf Sheets(StartList).Name = Left(Sheets(StartList).Name, 3) = "КН1" Then
                                Worksheets(StartList).Range("DA52:DF52").ClearContents                      'Удалить нумерацию КН1
                                
                                ElseIf Sheets(StartList).Name = Left(Sheets(StartList).Name, 2) = "КН" Then
                                   Worksheets(StartList).Range("DA53:DF53").ClearContents                   'Удалить нумерацию КН
                                   
                                   ElseIf Sheets(StartList).Name = Left(Sheets(StartList).Name, 3) = "ОК1" Then
                                      Worksheets(StartList).Range("OK_SkvNum1").ClearContents               'Удалить нумерацию ОК1

                                      ElseIf Sheets(StartList).Name = Left(Sheets(StartList).Name, 2) = "ОК" Then
                                         Worksheets(StartList).Range("OK_SkvNum2").ClearContents            'Удалить нумерацию ОК
                                      
'                                      End If
'                                   End If
'                                End If
'                             End If
'                          End If
'                       End If
'                    End If
'                 End If
              End If

        StartList = StartList + 1

        Next
  
End Sub
 
Денис Ш.,
Начнём с того, что у Вас переменная "а" нигде не фигурирует (т.е. цикл For a = 1 To ListiVse не имеет смысла), а т.к. StartList = 1, то все проверки проходят только для первого листа...
И да, откройте для себя select case, не мучайте if...

Не делайте мудрённых схем, если не набили руку. Создайте простой файл и тренеруйтесь/отрабатывайте на нём.
Изменено: tutochkin - 26.05.2022 17:05:31
 
Цитата
tutochkin написал:
а т.к. StartList = 1, то все проверки проходят только для первого листа...
Вы не правы, есть строка
Код
StartList = StartList + 1
Понятно, что достаточно переменной a, но работать будет и так. Без файла примера, сложно сказать, почему именно не работает.
Можете ещё посмотреть ТУТ
Изменено: Msi2102 - 26.05.2022 17:24:25
 
Msi2102,
В данный момент очищает ячейку только на двух листах
 
Вот это
Код
Sheets(StartList).Name = Left(Sheets(StartList).Name, 3) = "ВО1"

нужно писать вот так
Код
Left(Sheets(StartList).Name, 3) = "ВО1"

Для остальных строк тоже. Не должно быть конструкции А=В=С. В Вашем случае, по крайней мере
Скажи мне, кудесник, любимец ба’гов...
 
Попробуйте так
Код
Sub NumeraciyDelet1()
      Dim Current As Worksheet
      For Each Current In Worksheets
            If Current.Name = "Титул" Then
               Current.Range("DA31:DF31").ClearContents
            ElseIf Current.Name = Left(Current.Name, 3) = "ВО1" Then
               Current.Range("AY243:BA243").ClearContents
            ElseIf Current.Name = Left(Current.Name, 2) = "ВО" Then
               Current.Range("AZ254:BA254").ClearContents
'''''' не понял что за условие условием разберетесь сами
'            ElseIf NameLista = "МК1" Then
'                Worksheets(StartList).Range("SkvNum1").ClearContents
            ElseIf Current.Name = Left(Current.Name, 2) = "МК" Then
               Current.Range("SkvNum2").ClearContents
            ElseIf Current.Name = Left(Current.Name, 3) = "КН1" Then
               Current.Range("DA52:DF52").ClearContents
            ElseIf Current.Name = Left(Current.Name, 2) = "КН" Then
               Current.Range("DA53:DF53").ClearContents
            ElseIf Current.Name = Left(Current.Name, 3) = "ОК1" Then
               Current.Range("OK_SkvNum1").ClearContents
            ElseIf Current.Name = Left(Current.Name, 2) = "ОК" Then
               Current.Range("OK_SkvNum2").ClearContents
            End If
      Next
End Sub

С условиями не разбирался, проверяйте сами
 
_Boroda_,
Такой вариант работает, но не совсем подходит под условие. Часть листов надо проверять по трем левым символам а часть по двум
 
Код
Sub NumeraciyDelet()
    For a_ = 1 To Worksheets.Count
        With Worksheets(a_)
            nazv_ = .Name
            nazv2_ = Left(nazv_, 2)
            nazv3_ = Left(nazv_, 3)
            If nazv_ = "Титул" Then
                .Range("DA31:DF31").ClearContents
            ElseIf nazv3_ = "ВО1" Then
                .Range("AY243:BA243").ClearContents
            ElseIf nazv2_ = "ВО" Then
                .Range("AZ254:BA254").ClearContents
            ElseIf nazv_ = "МК1" Then
                .Range("SkvNum1").ClearContents
            ElseIf nazv2_ = "МК" Then
                .Range("SkvNum2").ClearContents
            ElseIf nazv3_ = "КН1" Then
                .Range("DA52:DF52").ClearContents
            ElseIf nazv2_ = "КН" Then
                .Range("DA53:DF53").ClearContents
            ElseIf nazv3_ = "ОК1" Then
                .Range("OK_SkvNum1").ClearContents
            ElseIf nazv2_ = "ОК" Then
                .Range("OK_SkvNum2").ClearContents
            End If
        End With
    Next
End Sub

И у Вас там скрытые листы еще есть, проверьте
И да,
Цитата
Msi2102 написал:
С условиями не разбирался, проверяйте сами
Изменено: _Boroda_ - 26.05.2022 18:03:34
Скажи мне, кудесник, любимец ба’гов...
 
Msi2102,
Тоже не удаляет данные из ячейки. Я так понимаю мне проще сделать два условия, по одному чтобы проверял по двум символам по другому по трем
 
Цитата
Денис Ш. написал:
Часть листов надо проверять по трем левым символам а часть по двум
Ну так и напишите не лефт 3, а Лефт 2, кто мешает-то?
Скажи мне, кудесник, любимец ба’гов...
 
_Boroda_,
Так там так и написано
 
Перед Next вставьте строку
Код
MsgBox Current.Name

И посмотрите какие листы макрос перебирает
Если макрос перебирает всё листы, то нужно проверять ваши условия. И ещё можете изменить диапазон удаления, например на "Range("A1:DF500" ) " И если во всём этом диапазоне на всех листах будет очищено содержимое, то вы ошиблись в выборе диапазона.
Изменено: Msi2102 - 26.05.2022 19:24:30
 
Всем большое спасибо.
Собрав все советы и рекомендации смог получить то что надо.
Если использовать строчку кода без Worksheets(a), то чистит только на том листе который активен:
Код
ElseIf NameLista2 = "КН" Then
                 Worksheets(a).Range("DA53:DF53").ClearContents

Выложу весь код, может пригодится кому-то:

Код
Sub NumeraciyUdalit()

    Dim a As Integer
    Dim NameLista As Variant
    Dim NameLista2 As Variant
    Dim NameLista3 As Variant
    
        For a = 1 To Worksheets.Count
            With Worksheets(a)
            
                 NameLista = .Name
                 NameLista2 = Left(NameLista, 2)
                 NameLista3 = Left(NameLista, 3)
                 
              If NameLista = "Титул" Then
                 Worksheets(a).Range("DA31:DF31").ClearContents         'Удалить нумерацию на титуле
                 
              ElseIf NameLista3 = "ВО1" Then
                 Worksheets(a).Range("AY243:BA243").ClearContents       'Удалить нумерацию на ВО
                 
              ElseIf NameLista2 = "ВО" Then
                 Worksheets(a).Range("AZ254:BA254").ClearContents       'Удалить нумерацию на ВО
                    
              ElseIf NameLista3 = "МК1" Then
                 Worksheets(a).Range("DA46:DF46").ClearContents         'Удалить нумерацию МК1

              ElseIf NameLista2 = "МК" Then
                 Worksheets(a).Range("DA47:DF47").ClearContents         'Удалить нумерацию МК1
                             
              ElseIf NameLista3 = "КН1" Then
                 Worksheets(a).Range("DA52:DF52").ClearContents         'Удалить нумерацию КН1
                                
              ElseIf NameLista2 = "КН" Then
                 Worksheets(a).Range("DA53:DF53").ClearContents         'Удалить нумерацию КН
                                   
              ElseIf NameLista3 = "ОК1" Then
                 Worksheets(a).Range("DA44:DF44").ClearContents         'Удалить нумерацию ОК1

              ElseIf NameLista2 = "ОК" Then
                 Worksheets(a).Range("CZ47:DF47").ClearContents         'Удалить нумерацию ОК
                 
              End If
        End With
    Next
End Sub
 
Цитата
Msi2102 написал:
Вы не правы, есть строка
Да, я был не прав... :)
 
Код
Sub Посвящается_kuklp_Сегодня_День_Сварщика()
she = Array("Титул", "ВО1", "ВО", "МК1", "МК", "КН1", "КН", "ОК1", "ОК")
rng = Array("DA31:DF31", "AY243:BA243", "AZ254:BA254", "DA46:DF46", "DA47:DF47", "DA52:DF52", "DA53:DF53", "DA44:DF44", "CZ47:DF47")
i = 0
For Each sh In she
Sheets(sh).Range(rng(i)).ClearContents
i = i + 1
Next sh
End Sub

В массиве sh() пропишите корректные названия листов.
Страницы: 1
Наверх