Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Оптимизация кода VBA с If...Then...ElseIf, соотнести неизменяемые данные с значениями из таблицы
 
Доброго времени суток, уважаемые Планетяне!
в файле Свод собираются данные из выгрузок получаемые из корпоративного ПО,
т.к. не силён в VBA, но с помощью нейросети смог накрапать такой код, собственно вопрос, есть возможность как то оптимизировать и/или сократить код или придется все 56 условий прописывать с конструкцией If...Then...ElseIf.
про поиск знаю, но вразумительного под свою задачу не нашёл, направьте если не сложно :)
(и под спойлер не получилось спрятать:()

Код
Sub СобратьДанныеИз_Вс_РФМТП()
    Dim ИмяПапки As String
    Dim ИмяФайла As Variant
    Dim ИсходнаяКнига As Workbook
    Dim ИсходныйЛист As Worksheet
    Dim ЭтаКнига As Workbook 'в ней находится макрос
    Dim ЛистКнигиСВОД As Worksheet 'в него вносим данные из файлов выгрузки
    Dim Значения1 As String '$D$2
    Dim Значения2 As Variant 'String * 1024 '$D$4
    Dim Значения3 As Variant '=ABS($G$11)/1000
    Dim Значения4 As Variant '$G$5
    Dim Значения5 As Variant '$G$8
    Dim i As Variant
    Dim ДанныеСвод As String
    Dim strPath As String
    'ОбобщенныеДанные = ""
   
    
    ' Определяем книгу для обобщенных данных
    Set ЭтаКнига = ActiveWorkbook
       


    ' Определяем лист для обобщенных данных
    Set ЛистКнигиСВОД = ЭтаКнига.Sheets(1) '
    
    ' Пользователь выбирает файлы
    ИмяФайла = Application.GetOpenFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Выберите Множестово файлов или один файл", MultiSelect:=True)
    
    If Not IsArray(ИмяФайла) Then
        Exit Sub ' Пользователь нажал "Отмена"
    End If
    
     
    For i = LBound(ИмяФайла) To UBound(ИмяФайла)
        ' Открываем исходную книгу
        Set ИсходнаяКнига = Workbooks.Open(ИмяФайла(i))
       
    For Each ИсходныйЛист In ИсходнаяКнига.Sheets
        If ИсходныйЛист.Name = "РФМ" Then
      ИсходныйЛист.UsedRange.Value = ИсходныйЛист.UsedRange.Value
      
            ' Получаем значения из указанных ячеек
            Значения1 = ИсходныйЛист.Range("D2").Value ' период:
            'здесь надо применить справочник, что бы рассортировать объекты по ТП
            Значения2 = ИсходныйЛист.Range("D4").Value 'Объекты
            Значения3 = Abs(ИсходныйЛист.Range("G11").Value) / 1000  'Итого потребление/ 1000
            Значения4 = ИсходныйЛист.Range("G5").Value 'Максимальная потребленная  мощность
            Значения5 = ИсходныйЛист.Range("G8").Value 'Среднеарифметическая фактическая потребленная мощность




            With ЛистКнигиСВОД
                Dim СтрокаДляЗаписи As Long
                If Значения2 = "Гр.ТП  Амазар-Ростов-на-Дону/т (ВЛ-7226), репер №1; ВЛ 220 кВ Долгопрудный/т- Ростов-на-Дону/т, репер №71 (2)" Then
                    СтрокаДляЗаписи = 6 'пока специально указал 6 строку
                .Cells(СтрокаДляЗаписи, 1).Value = Значения1
                .Cells(СтрокаДляЗаписи, 3).Value = Значения3
                .Cells(СтрокаДляЗаписи, 4).Value = Значения4
                .Cells(СтрокаДляЗаписи, 5).Value = Значения5
                ElseIf Значения2 = "Гр.ТП ВЛ 220 кВ Ульяновск/т-Долгопрудный/т, репер №62; ВЛ 220 кВ Уруша/т- Долгопрудный/т, репер №170; ВЛ 220 кВ Долгопрудный/т-Ростов-на-Дону/т; ВЛ 220 кВ Долгопрудный/т - Чичатка, репер №1 (4)" Then
                     СтрокаДляЗаписи = 5
                .Cells(СтрокаДляЗаписи, 1).Value = Значения1
                .Cells(СтрокаДляЗаписи, 3).Value = Значения3
                .Cells(СтрокаДляЗаписи, 4).Value = Значения4
                .Cells(СтрокаДляЗаписи, 5).Value = Значения5
                  
                End If
            End With
        End If
    Next ИсходныйЛист
        ' Закрываем исходную книгу без сохранения
        ИсходнаяКнига.Close savechanges:=False
    Next i


    ' Выводим обобщенные данные в окно сообщений
    MsgBox "Данные были успешно занесены в свод."


End Sub
Объединение значений некоторых строк в PQ, объединить строки которые разорвались при выгрузке через PQ
 
Доброго времени суток, уважаемые!
решения по форуму не смог найти, прошу ткнуть куда копать
или подсказать в этом топике
изначально выгружается файл в формате html, который потом уже причесывается в Экселе, но при выгрузке некоторые строки разрываются на части с переносом в следующую под ней ячейку, затем от 3 до 10 пустых ячеек, затем опять строка может с разрывом или цельная.
пример только для демонстрации проблемы
Вопрос: каким образом склеить только разорванные строки через PQ
Выборка из массива с копированием части данных в новую книгу
 
доброго времени суток, уважаемые форумчане!
довольно много времени пытался найти самостоятельно решение моей задачи, но потерпел неудачу :(
осталось надеяться на ВАШИ "светлые" головы ;)
задача заключается в следующем: есть база сотрудников (лист1 книги Тест) с частью необходимой информации (оставшаяся часть берется из другой базы), нужно создать другую (третью) базу в которой будут попадать только необходимые данные.
предположим что сотрудников больше 3000 чел и 60% из них должны попасть в мою базу (в усеченном виде представлена на листе2 книги Тест).
фильтром уже устал пользоваться и копировать кусочками для переноса. говорят, что 95% задач уже решены, но на свой вопрос как сделать так, что бы в определенном поле вбивать часть Фамилии Имени можно было копировать с одного листа в другой, я не нашел.
заранее спасибо за ответы и за ваше потраченное время!
PS. Excel 2013
Страницы: 1
Наверх