Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » Денис Ш.
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1 2 3 След.
Метод paste из класса worksheet завершен неверно
 
#
06.10.2024 17:21:43
Добрый день.
Подскажите, есть книга с большим количеством макросов.
На старом компьютере работала без проблем, у коллеги работает так же все без проблем.
У меня выдает ошибку Метод paste из класса worksheet завершен неверно.
После перезагрузки один раз отрабатывает и потом опять выдает данную ошибку.
В чем может быть проблема?
Код на котором останавливается выполнение ниже.
Остановка происходит на ActiveSheet.Paste
Так же в офисе 10 работает в 21 нет
Код
'Если реально новая позиция                    If newpoz Then
                            If Not firstpoz And IsinstrinPos Then
                              ' Если в предыдущей РП заполнялся инструмент в столбик позиции, то
                              'заносим рабочую позицию  и вылет в предыдущий столбик,
                              'а потом уже переходим на новый столбик.
                              ' Запомнить время работы в этой позиции
                              'ipoz = ipoz + 1
                              'WorkPozTimes(ipoz) = alltime
                             ' WorkPozTimes(thisoperPozKol) = alltime
                              With Sheets(newlistname)
                                If AllKHlistnum = 1 And pozitionkol = 1 Then
                                    .Range("RabPoz1_1").Value = "Т" + curpos
                                    .Range("Vylet1_1").Value = vylet
                                    '.Range("RabTime1_1").Value = alltime ' вносить на лист будуем теперь позже
                                    ' И запомнить место для времени
                                    WorkPozTimeSheets(thisoperPozKol) = newlistname
                                    WorkPozTimeAddress(thisoperPozKol) = .Range("RabTime1_1").Address
                                    If Not CurRis Is Nothing Then
                                        CurRis.CopyPicture
                                        .Range("Ris1_1").Select
                                        ActiveSheet.Paste
                                        sdsd = CurRis.Width
                                        kkk = (Ris1Width - CurRis.Width) / 2
                                        Selection.ShapeRange.IncrementLeft kkk
                                        kkk = (Ris1Height - CurRis.Height) / 2
                                        Selection.ShapeRange.IncrementTop kkk
Изменено: Денис Ш. - 06.10.2024 17:38:52
 
Перейти    
Импорт данных из папки с несколькими файлами (Power Query)
 
#
04.04.2023 16:22:25
surkenny, поэтому и спрашиваю как такое возможно, пробовал несколько раз делать запрос через power query, по разным папкам, больше чем 101 стоки в таблице не заполняет. К сожалению файл предоставить не могу так как объем данных большой и вес не проходит.
 
Перейти    
Импорт данных из папки с несколькими файлами (Power Query)
 
#
04.04.2023 14:47:00
Вот на этом список закончился.
А в редакторе Power Query база порядка 13000, можно как-то из нее в обычный эксель перевести?
Изменено: Денис Ш. - 04.04.2023 14:48:25
 
Перейти    
Импорт данных из папки с несколькими файлами (Power Query)
 
#
04.04.2023 14:44:23
Alien Sphinx, я в таблице эксель получил всего 101 строку данных. А в редакторе 13000
Изменено: Денис Ш. - 04.04.2023 14:45:22
 
Перейти    
Импорт данных из папки с несколькими файлами (Power Query)
 
#
04.04.2023 14:30:13
Приветствую.
Подскажите, через Power Query импортировал данные из папки. В папке порядка 2000 файлов, но в полученной таблице только заполнено 101 строка. Можно как то расширить?
 
Перейти    
Проверка значения ячеек и заполнение соседней
 
#
01.08.2022 15:44:57
New, Благодарю, учту
 
Перейти    
Проверка значения ячеек и заполнение соседней
 
#
01.08.2022 15:44:35
Ігор Гончаренко, Спасибо
 
Перейти    
Проверка значения ячеек и заполнение соседней
 
#
01.08.2022 15:26:34
Msi2102, Ваш код на много лучше. У меня пока получается примитивными командами. Подскажите, почему при запуске вашего кода у меня потребовало обозначить переменные arr1 и arr2?
 
Перейти    
Проверка значения ячеек и заполнение соседней
 
#
01.08.2022 14:51:21
Получилось решить задачу таким способом:
Код
Sub Name()
Dim a As Variant

For a = 2 To 30
          
            If Cells(a, "A") = "ОТИ-4" Then
               Worksheets("Список инструкций").Cells(a, "D") = "По охране труда контролёров БТК"
               
            ElseIf Cells(a, "A") = "ОТИ-18" Then
               Worksheets("Список инструкций").Cells(a, "D") = "По охране труда сверловщика"
  
            ElseIf Cells(a, "A") = "ОТИ-19" Then
               Worksheets("Список инструкций").Cells(a, "D") = "По охране труда зубошлифовщика"
               
            ElseIf Cells(a, "A") = "ОТИ-22" Then
               Worksheets("Список инструкций").Cells(a, "D") = "По охране труда протяжчика"
               
            ElseIf Cells(a, "A") = "ОТИ-52" Then
               Worksheets("Список инструкций").Cells(a, "D") = "По охране труда шлифовщиков"
               
            ElseIf Cells(a, "A") = "ОТИ-53" Then
               Worksheets("Список инструкций").Cells(a, "D") = "По охране труда при эскплуатации абразивного инструмента"
               
            ElseIf Cells(a, "A") = "ОТИ-57" Then
               Worksheets("Список инструкций").Cells(a, "D") = "По охране труда для фрезеровщика"
               
            ElseIf Cells(a, "A") = "ОТИ-60" Then
               Worksheets("Список инструкций").Cells(a, "D") = "По охране труда для грузчиков, и лиц, выполняющих погрузочно-разгрузочные и складские работы"
               
            ElseIf Cells(a, "A") = "ОТИ-65" Then
               Worksheets("Список инструкций").Cells(a, "D") = "По охране труда для стропальщиков"
               
            ElseIf Cells(a, "A") = "ОТИ-80" Then
               Worksheets("Список инструкций").Cells(a, "D") = "По охране труда для лиц, занятых управлением грузоподъёмными кранами с пола или стационарного пульта"
               
            ElseIf Cells(a, "A") = "ОТИ-118" Then
               Worksheets("Список инструкций").Cells(a, "D") = "По охране труда при работе на координатно-измерительных машинах (КИМ)"
               
            ElseIf Cells(a, "A") = "ОТИ-144" Then
               Worksheets("Список инструкций").Cells(a, "D") = "По охране труда при работе на долбёжных станках"
               
            ElseIf Cells(a, "A") = "ОТИ-192" Then
               Worksheets("Список инструкций").Cells(a, "D") = "По охране труда зуборезчика"
               
            ElseIf Cells(a, "A") = "ОТИ-451" Then
               Worksheets("Список инструкций").Cells(a, "D") = "По охране труда станочников"
               
            ElseIf Cells(a, "A") = "ОТИ-491" Then
               Worksheets("Список инструкций").Cells(a, "D") = "По охране труда для машинистов моечных машин"
               
            ElseIf Cells(a, "A") = "ОТИ-510" Then
               Worksheets("Список инструкций").Cells(a, "D") = "По охране труда для лиц, занятых обработкой металла с использованием смазочно-охлаждающих жидкостей"
               
            ElseIf Cells(a, "A") = "ОТИ-810" Then
               Worksheets("Список инструкций").Cells(a, "D") = "По охране труда при работе с ручным слесарным инструментом"
               
            ElseIf Cells(a, "A") = "ОТИ-1012" Then
               Worksheets("Список инструкций").Cells(a, "D") = "По охране труда для дефектоскопистов по магнитному и ультразвуковому контролю"
               
            ElseIf Cells(a, "A") = "ОТИ-1244" Then
               Worksheets("Список инструкций").Cells(a, "D") = "По охране труда для операторов станков с программным управлением"
                
            End If
Next
    
End Sub
 
Перейти    
Проверка значения ячеек и заполнение соседней
 
#
01.08.2022 14:20:45
Ігор Гончаренко, Спасибо. С ВПР да, получается реализовать. Хочу именно в vba, чтобы не добавлять лист в документ и названия тянулись из кода. Понимаю что нужно будет все условия прописать. Я не селен в vba похожего примера на форумах не нашел
 
Перейти    
Проверка значения ячеек и заполнение соседней
 
#
01.08.2022 13:59:02
Добрый день!
Подскажите как сделать макросом, проверку значения в колонке А и согласно найденному значению заполнять соответствующую ячейку в колонке С.
Например: проверяем А2 если там ОТИ-4 тогда заполняем в С2 "По охране труда контролёров БТК". Вариантов значений будет порядка 20. То есть  если в А2 другое значение то в С2 тоже другие данные. Ниже привел соответствие ОТИ и данным в колонке С
ОТИ-4По   охране труда контролёров БТК
ОТИ-18По охране труда сверловщика
ОТИ-19По охране труда   зубошлифовщика
ОТИ-22По охране труда протяжчика
ОТИ-52По охране труда шлифовщиков
ОТИ-53По охране труда при   эскплуатации абразивного инструмента
ОТИ-57По охране труда для   фрезеровщика
ОТИ-60По охране труда для   грузчиков, и лиц, выполняющих погрузочно-разгрузочные и складские работы
ОТИ-65По охране труда для   стропальщиков
ОТИ-80По охране труда для лиц,   занятых управлением грузоподъёмными кранами с пола или стационарного пульта
ОТИ-118По охране труда при работе   на координатно-измерительных машинах (КИМ)
ОТИ-144По охране труда при работе   на долбёжных станках
ОТИ-192По охране труда зуборезчика
ОТИ-451По охране труда станочников
ОТИ-491По охране труда для   машинистов моечных машин
ОТИ-510По охране труда для лиц,   занятых обработкой металла с использованием смазочно-охлаждающих жидкостей
ОТИ-810По охране труда при работе   с ручным слесарным инструментом
ОТИ-1012По охране труда для   дефектоскопистов по магнитному и ультразвуковому контролю
ОТИ-1244По охране труда для   операторов станков с программным управлением
 
Перейти    
Формирование списка разделяя текст в ячейке по строкам
 
#
29.07.2022 17:25:41
Вроде бы получилось. Я указал на каком листе искать последнюю заполненную строчку:
Код
Sub aaaaaaaaaaaaaaa()
Dim arr As Variant, arr1 As Variant, arr2 As Variant, dic As Variant, i As Variant, n As Variant, y As Variant

Set dic = CreateObject("Scripting.Dictionary")
arr1 = Sheets("Рабочая база деталей").Range("A9:H" & Sheets("Рабочая база деталей").Cells(Rows.Count, 1).End(xlUp).Row).Value
For i = 1 To UBound(arr1)
    arr = Split(arr1(i, 8), "; ")
    For n = LBound(arr) To UBound(arr)
        If Not dic.exists(arr(n)) Then Set dic(arr(n)) = CreateObject("Scripting.Dictionary")
        If Not dic(arr(n)).exists(CStr(arr1(i, 5))) Then dic(arr(n)).Add CStr(arr1(i, 5)), CStr(arr1(i, 5))
    Next
Next
ReDim arr2(1 To dic.Count, 1 To 2)
n = 0
For Each y In dic
    n = n + 1
    arr2(n, 1) = y
    arr2(n, 2) = Join(dic(y).keys, "; ")
Next
Worksheets("Список инструкций").Cells(2, 1).Resize(UBound(arr2), 2) = arr2
End Sub
 
Перейти    
Формирование списка разделяя текст в ячейке по строкам
 
#
29.07.2022 16:33:43
Msi2102, Поменялась немного структура документа. С листа "Список инструкций"? Чтобы кнопка была не на листе Данные... Пытался сделать, но почему-то если запустить с другого листа данные выдает совершено другие
Изменено: Денис Ш. - 29.07.2022 16:34:46
 
Перейти    
Ошибка "Method range of object _worksheet failed"
 
#
22.06.2022 23:28:52
Здравствуйте! При отработке макроса возникает ошибка "Method range of object _worksheet failed". Макрос ставит номера страниц на листах в книге.
Проблема начала возникать когда увеличилось число листов.
Подозреваю, что дело в количестве листов ОК, т.е. ОК1, ОК2, ОК3, ОК4, ОК5, .... ОК9 на них все отлично работает, а вот на ОК10 уже выдает ошибку

Ругается конкретно на строку:
Код
xSheet_xSheet_xSheet.Range("OK_SkvNum1").Value = List_List_List(2)

В условии:

Код
If StrConv(xSheet_xSheet_xSheet.Name, 1) Like "*" & "OК" & "*" Then
        If StrConv(xSheet_xSheet_xSheet.Name, 1) Like "*" & "OК1" & "*" Then
        xSheet_xSheet_xSheet.Range("OK_SkvNum1").Value = List_List_List(2)
        Else
        xSheet_xSheet_xSheet.Range("CZ47").Value = List_List_List(2)
        End If
    End If

Код
List_List_List(1) = 0
List_List_List(2) = 1
For Each xSheet_xSheet_xSheet In ActiveWorkbook.Sheets
If xSheet_xSheet_xSheet.Visible = True Then List_List_List(1) = List_List_List(1) + 1
Next

For Each xSheet_xSheet_xSheet In ActiveWorkbook.Sheets
If xSheet_xSheet_xSheet.Visible = True Then
    
    If StrConv(xSheet_xSheet_xSheet.Name, 1) Like "*" & "ТИТУЛ" & "*" Then
    xSheet_xSheet_xSheet.Range("SkvNumTotal").Value = List_List_List(1)
    xSheet_xSheet_xSheet.Range("SkvNum1").Value = List_List_List(2)
    xSheet_xSheet_xSheet.Range("DA31").Value = List_List_List(2)
    End If

    If StrConv(xSheet_xSheet_xSheet.Name, 1) Like "*" & "МК" & "*" Then
        If StrConv(xSheet_xSheet_xSheet.Name, 1) = "МК1" Then
        xSheet_xSheet_xSheet.Range("SkvNum1").Value = List_List_List(2)
        Else
        xSheet_xSheet_xSheet.Range("da47").Value = List_List_List(2)
        End If
    End If

    If StrConv(xSheet_xSheet_xSheet.Name, 1) Like "*" & "OК" & "*" Then
        If StrConv(xSheet_xSheet_xSheet.Name, 1) Like "*" & "OК1" & "*" Then
        xSheet_xSheet_xSheet.Range("OK_SkvNum1").Value = List_List_List(2)
        Else
        xSheet_xSheet_xSheet.Range("CZ47").Value = List_List_List(2)
        End If
    End If
    
    If StrConv(xSheet_xSheet_xSheet.Name, 1) Like "*" & "ВО" & "*" Then
        If StrConv(xSheet_xSheet_xSheet.Name, 1) Like "*" & "ВО1" & "*" Then
        xSheet_xSheet_xSheet.Range("AY243").Value = List_List_List(2)
        Else
        xSheet_xSheet_xSheet.Range("AZ254").Value = List_List_List(2)
        End If
    End If
        
    If StrConv(xSheet_xSheet_xSheet.Name, 1) Like "*" & "КН" & "*" Then
    xSheet_xSheet_xSheet.Range("DA52").Value = List_List_List(2)
    End If
List_List_List(2) = List_List_List(2) + 1
End If
Next

Set xSheet_xSheet_xSheet = Nothing
Erase List_List_List
Изменено: Денис Ш. - 22.06.2022 23:41:08
 
Перейти    
Формирование списка разделяя текст в ячейке по строкам
 
#
20.06.2022 16:55:16
artemkau88, Все круто, спасибо большое!
 
Перейти    
Формирование списка разделяя текст в ячейке по строкам
 
#
20.06.2022 09:44:13
artemkau88, Добрый день. Немного не то. Листы ПИ1 и ПИ2 немного отличаются форматом, т.е. ПИ1 всегда должен быть первым, а вот ПИ2 уже множить по содержимому., вот как файл
Цитата
artemkau88, как говорят "аппетит приходит во время еды"
Можно тоже самое реализовать но заполнять таблицу на листе ПИ1:
Обозначение - список ОТИ
Номера операций - номера операций
Если строк не хватает, то перейти на лист ПИ2, если и с ним не хватает то добавить копию листа ПИ2
Прикрепленные файлы
И еще можно перенести номера операций в колонку крайнюю правую, сейчас вносятся в колонку с наименованием
 
Перейти    
Формирование списка разделяя текст в ячейке по строкам
 
#
18.06.2022 12:29:39
artemkau88, Например, если не хватает двух листов для заполнения, то скопировать ПИ2 но под именем ПИ3 и заполнять оставшиеся в него
 
Перейти    
Формирование списка разделяя текст в ячейке по строкам
 
#
17.06.2022 10:36:12
artemkau88, Спасибо, все круто, но когда избыток инструкций он перезаписывает их на листе ПИ2
 
Перейти    
Формирование списка разделяя текст в ячейке по строкам
 
#
15.06.2022 22:52:26
artemkau88, как говорят "аппетит приходит во время еды"
Можно тоже самое реализовать но заполнять таблицу на листе ПИ1:
Обозначение - список ОТИ
Номера операций - номера операций
Если строк не хватает, то перейти на лист ПИ2, если и с ним не хватает то добавить копию листа ПИ2
 
Перейти    
Формирование списка разделяя текст в ячейке по строкам
 
#
15.06.2022 20:51:56
artemkau88, Прошу простить меня, я последний что увидел попробовал и удалился от компа.
Ваш тоже делает то что надо, только поправил чуть-чуть, выводил не номер операции а номер цеха
Код
Sub Интрукция_Операция()
Dim arr, Dict As Object
Dim i, j, t, tmp, temp, lr As Long

arr = Worksheets("Данные").Cells(1, 1).CurrentRegion
Set Dict = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(arr, 1)
    If InStr(arr(i, 7), ";") Then
        tmp = Split(arr(i, 7), ";")
        For Each j In tmp
            j = Trim(j)
            If InStr(j, ",") Then
                temp = Split(j, ",")
                For Each t In temp
                    t = Trim(t)
                    If Not Dict.exists(t) Then
                        Dict.Add t, arr(i, 5)
                    Else
                        If InStr(Dict(t), arr(i, 5)) = 0 Then
                            Dict(t) = Dict(t) & ";" & arr(i, 5)
                        End If
                    End If
                Next t
            
            Else
                If Not Dict.exists(j) Then
                    Dict.Add j, arr(i, 5)
                Else
                    If InStr(Dict(j), arr(i, 5)) = 0 Then
                        Dict(j) = Dict(j) & ";" & arr(i, 5)
                    End If
                End If
            End If
        Next j
    Else
        If Not Dict.exists(arr(i, 7)) Then
            Dict.Add arr(i, 7), arr(i, 5)
        Else
            If InStr(Dict(arr(i, 7)), arr(i, 5)) = 0 Then
                Dict(arr(i, 7)) = Dict(arr(i, 7)) & ";" & arr(i, 5)
            End If
        End If
    End If
Next i
With Worksheets("Список инструкций")
    .Range(.Cells(2, 1).End(xlDown), .Cells(2, 1).End(xlToRight)).ClearContents
For Each j In Dict.keys
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Cells(lr + 1, 1) = j
    .Cells(lr + 1, 2) = Dict(j)
Next j
End With
End Sub
 
Перейти    
Формирование списка разделяя текст в ячейке по строкам
 
#
15.06.2022 18:29:01
Msi2102, Спасибо, то что нужно, разобраться бы в этом теперь. Я пытался пойти в этом направлении
Код
Sub Список_инструкций()

Dim i&, x
Dim aaa As Variant
Dim zzz As Variant
Dim diapazon As Variant

diapazon = Range("G2:G5")

For Each zzz In diapazon
    For Each x In Split(zzz, "; ")
        If x <> "" Then i = i + 1: Cells(i, 12) = x
    Next x
Next zzz

Columns(12).RemoveDuplicates 1

End Sub
 
Перейти    
Формирование списка разделяя текст в ячейке по строкам
 
#
15.06.2022 18:27:00
Msi2102, Запятая это ошибка в заполнении. ОТИ-80 и ОТИ-080 это разное
 
Перейти    
Формирование списка разделяя текст в ячейке по строкам
 
#
15.06.2022 16:08:05
Добрый день!
Подскажите как можно реализовать на языке VBA, формирование списка?
В столбце "инструкция", на листе "данные" имеем перечень инструкций, они разделены ; (точкой с запятой), нужно на лист "Список инструкций" в колонку инструкция внести все инструкции без дубликатов.

Пример:
если в ячейке: ОТИ-1244; ОТИ-451; ОТИ-510, ОТИ-80
то сделать как:
ОТИ-1244
ОТИ-451
ОТИ-510
ОТИ-80

После сформированного списка на листе "Список инструкций" в колонку "Операция" занести все операции через ; (точкой с запятой) в которых используется эта инструкция.

Пример:
Имеем инструкцию ОТИ-080 она используется в операциях 005; 010
 
Перейти    
Вставка строки с форматом как сверху или снизу
 
#
07.06.2022 19:04:29
Здравствуйте!
Возникла проблема с добавлениями строк в таблицу. У таблицы определены границы, но когда добавляешь новую строку строка добавляется как будто с очищенным форматом, хотя в свойствах стоит "как сверху". Подскажите что может быть причиной данной проблемы.
К сожалению файл меньше чем 500 кб не получается сделать.
Выложил на яндекс: https://disk.yandex.ru/i/YlgntPaoKJEonw
 
Перейти    
Очистка ячейки если имя листа равно значению
 
#
27.05.2022 10:02:27
Всем большое спасибо.
Собрав все советы и рекомендации смог получить то что надо.
Если использовать строчку кода без 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
 
Перейти    
Очистка ячейки если имя листа равно значению
 
#
26.05.2022 18:06:45
_Boroda_,
Так там так и написано
 
Перейти    
Очистка ячейки если имя листа равно значению
 
#
26.05.2022 18:04:30
Msi2102,
Тоже не удаляет данные из ячейки. Я так понимаю мне проще сделать два условия, по одному чтобы проверял по двум символам по другому по трем
 
Перейти    
Очистка ячейки если имя листа равно значению
 
#
26.05.2022 18:00:40
_Boroda_,
Такой вариант работает, но не совсем подходит под условие. Часть листов надо проверять по трем левым символам а часть по двум
 
Перейти    
Очистка ячейки если имя листа равно значению
 
#
26.05.2022 17:28:20
Msi2102,
В данный момент очищает ячейку только на двух листах
 
Перейти    
Очистка ячейки если имя листа равно значению
 
#
26.05.2022 16:52:16
Добрый день!
Я в 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
 
Перейти    
Страницы: 1 2 3 След.
Наверх