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

Страницы: 1
Импорт данных из папки с несколькими файлами (Power Query)
 
#
04.04.2023 14:30:13
Приветствую.
Подскажите, через Power Query импортировал данные из папки. В папке порядка 2000 файлов, но в полученной таблице только заполнено 101 строка. Можно как то расширить?
 
Перейти    
Проверка значения ячеек и заполнение соседней
 
#
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По охране труда для   операторов станков с программным управлением
 
Перейти    
Ошибка "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
 
Перейти    
Формирование списка разделяя текст в ячейке по строкам
 
#
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
 
Перейти    
Очистка ячейки если имя листа равно значению
 
#
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
 
Перейти    
Перемещение листов в книге, Перемещение листов согласно их имени
 
#
18.05.2022 10:02:23
Добрый день!
Подскажите, как можно реализовать в VBA анализ листов книги и отсортировать их исходя из имени листов?
А именно на примере файла во вложении: имеем книгу с листами ОП-010, ОП-015, ОП-030, КН-010, КН-015, КН-030, ВО-1, ВО-2
Нужно вызовом макроса расставить листы в таком порядке: ВО-1, ВО-2, КН-010, ОП-010, КН-015, ОП-015, КН-030, ОП-030
Т.е. листы КН должны быть перед листами ОП согласно их номеру 010 перед 010
 
Перейти    
"Пропадает иконка автозаполнения после выполнения макроса поиска
 
#
30.10.2021 19:32:30
Здравствуйте!
Подскажите в чем проблема. Добавил в книгу макрос, который ищет необходимое значение ячейки и заполняет относительно ее другие.
Но возникла проблема после выполнения макроса, а именно, до выполнения макроса при протягивании ячеек появляется иконка параметров автозаполнения, после выполнения макроса она не появляется, приходится удалять строки которые заполнил макрос.
 
Перейти    
Подсчет количества уникальных по условию
 
#
29.09.2021 12:16:45
Добрый день!
Подскажите как можно реализовать подсчет количества уникальных значений по условию.
Подробнее то так:
Имеем условие Группа 1, в таблице есть столбец с группами и с данными (Т1, Т2, и т.д) хочу получить количество Т1, Т2 используемые в группе 1
 
Перейти    
Работа только с видимыми ячейками
 
#
24.10.2019 09:13:24

Добрый день! Подскажите как можно поправить код чтобы он работал только с видимыми ячейками, а не с тебе что скрыты под фильтром

Код
Sub proba()
    Dim nCol As Integer
    Dim nGr As Integer

    Range("A2:S" & Cells(Rows.Count, 1).End(xlUp).Row).Select    
    nCol = 5    
    Range("A2:S" & Cells(Rows.Count, 1).End(xlUp).Row).Borders.LineStyle = False

    If nCol < 1 Or nCol > Selection.Columns.Count Then Exit Sub

    For r = 1 To Selection.Rows.Count
        If Cells(r, nCol) <> Cells(r + 1, nCol) Then Range(Cells(r, 1), Cells(r, "S")).Select
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 3
            .TintAndShade = 0
            .Weight = xlThin
        End With
    Next r
End Sub
 
Перейти    
Макрос для закраски набора строк
 
#
22.10.2019 10:50:28
Здравствуйте! Подскажите как можно поправить данный макрос, чтобы не выделять диапазон какой хочу закрасить, а чтобы он был указан уже в макросе. И сразу в нем указать конкретный столбец по которому будет происходить условие закраски?
Код
Sub Highlight_Rows_Blocks()
    Dim nCol As Integer
    Dim nGr As Integer

    nCol = Application.InputBox(Prompt:="Введите номер столбца", Type:=1)
    If nCol < 1 Or nCol > Selection.Columns.Count Then Exit Sub
    Selection.Interior.ColorIndex = -4142

    For r = 1 To Selection.Rows.Count
        If Selection.Cells(r, nCol) <> Selection.Cells(r - 1, nCol) Then nGr = nGr + 1
        If nGr Mod 2 Then Selection.Rows(r).Interior.ColorIndex = 36
    Next r
End Sub
 
Перейти    
Распределение значения по другим ячейкам
 
#
21.10.2019 16:57:59
Добрый день! Подскажите можно ли сделать так, чтобы излишнее значение распределялось по другим ячейкам.
В ячейках "J2" по "N2" стоят значения, допустимое max это "1", если в одной ячейке значение 1,01 то в этой ячейке необходимо оставить 1 а 0,01 прибавить к другой, в которой значение меньше 1
 
Перейти    
Копирование в VBA только значения ячеек
 
#
17.10.2019 15:43:07
Подскажите как исправить код чтобы копировались только значения ячеек:
Код
Sub COPY_TOLKO_ZAGOTOVITELNU()
Dim iLastRow As Long, i As Long, LastRow As Long
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("DATA000")
        LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        'Cells(LastRow + 1, "D").ClearContents
        'Range("D2:D10").ClearContents
        .Range(.Cells(2, "D"), .Cells(LastRow + 1, "D")).ClearContents
        .Range(.Cells(2, "J"), .Cells(LastRow + 1, "J")).ClearContents
        .Range(.Cells(2, "P"), .Cells(LastRow + 1, "P")).ClearContents
        LastRow = 1
        For i = 2 To iLastRow
                If InStr(1, Cells(i, "O"), "zag", vbTextCompare) <> 0 Then
                    Cells(i, "H").COPY .Cells(LastRow + 1, "D")
                    Cells(i, "K").COPY .Cells(LastRow + 1, "J")
                    Cells(i, "I").COPY .Cells(LastRow + 1, "P")
                    LastRow = LastRow + 1
                End If
        Next
    End With
End Sub
 
Перейти    
Копирование данных с листа по условию
 
#
16.10.2019 15:52:13
Добрый день!
Подскажите как реализовать копирование данных с одного листа на другой по условию!
А именно:
Имеем лист "маршруты" где постоянно обновляются данные, их необходимо скопировать на лист "DATA000" в соответствующие столбцы (идентичные по названию).
На листе "DATA000" в других столбцах формулы, необходимо чтобы копировались/обновлялись данные только в тех столбиках где нет формул.
Условие копирования на листе "маршруты" в колонке R, если написано там "zag" то эти данные пропускать
 
Перейти    
Вырезать из ячейки значение с поиском по символу
 
#
10.04.2019 15:34:21
Добрый день! Подскажите как можно сделать с помощью формул вырезание значения:
ДанныеЧто необходимо получить
3:112 - 112;4:017;5:228;                     112
3:112 - 228;4:017;                     112
3:112 - 228;4:228 - 236;5:017;                     228
Необходимо искать справа на лево знак "-" и оставлять значение идущее перед ним (выделил красным)
Изменено: Денис Ш. - 10.04.2019 15:35:27
 
Перейти    
Заполнение ячейки если значение другой меньше 5% от числа
 
#
21.03.2019 10:25:43
Добрый день! Подскажите можно ли реализовать заполнение ячеек, подсвеченные зеленым в примере, исходя из условия:
Если значение для одной группы в столбце "Исх_Труд" больше пяти процентов значения ячейки Е144, то ячейка в столбце "Прин_труд" равна значению ячейки "Исх_Труд", иначе идет проверка всей строки в ячейках столбца "Исх_Труд", находится максимальное значение и уже к тому значение суммируется меньшее.
Попробую расписать примером:
группа 100_3, операция Выдержка. Исх_Труд меньше 5% (ячейка Е4), принимает в этой группе на эту операцию в ячейке Прин_труд ( ячейка Н4) значение равное нулю, ищем в строке этой операцию где наибольшая Исх_Труд, это группа 103_2 (ячейка М4) и заполняем ячейку (Р4) Прин_труд в этой группе равной сумме значений ячеек Е4+М4, т.е. Р4 будет равно 10,05
За ранее спасибо!
Изменено: Денис Ш. - 21.03.2019 10:54:30
 
Перейти    
Перенос значений из ячеек вертикального столбца в горизонтальные (объединенные)
 
#
20.03.2019 14:29:44
Добрый день! Подскажите как можно реализовать перенос данных из столбца А в горизонтальные объединенные ячейки выделенные желтым.
Файл примера во вложении, но он уменьшен, в оригинале данных намного больше.
 
Перейти    
Страницы: 1
Наверх