Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Как с помощью VBA скопировать информацию с одного листа в другой по условию
 
#1
03.08.2022 10:02:35
Добрый день, знатоки!
Есть большая таблица (выгрузка из одной программы) в которой много столбцов, и очень много строк, где столбцы могу менять свой порядок, добавляться новые, удалятся старые и т.д. Допустим столбец с названием "Начало" был "С", в следующей выгрузке может стать "Н".
Задача: сформировать "Свод" на новом листе с определёнными столбцами, и в определённом порядке с копированием данных, данная задача реализована поиском информации в интернете в том числе и на этом форуме. Но есть одно но, в листе "Свод", в один из столбец нужно собрать информацию из нескольких столбцов листа "Выгрузка" по определенному условию и как это внедрить в макрос у меня не хватает опыта, уж простите))) Пример условия прописал в листе "Свод" столбец "Н"
Файл с примером прилагаю.
 
 
 
#2
03.08.2022 10:48:27
Денис,
просто запишите Ваш макрос:
фильтруете таблицу по Вашим условиям
копируете ее
вставляете на другой лист
слегка корректируете макрос
 
 
 
#3
03.08.2022 12:14:22
Цитата
написал:
Денис,
просто запишите Ваш макрос:
фильтруете таблицу по Вашим условиям
копируете ее
вставляете на другой лист
слегка корректируете макрос
Спасибо, но я не понял суть вашего предложения.
 
 
 
#4
03.08.2022 12:15:48
Денис,
запишите макрос с помощью макрорекордера.
На вкладке "Разработчик" кнопка "Записать макрос"
 
 
 
#5
03.08.2022 13:40:56
Цитата
написал:
Денис,
запишите макрос с помощью макрорекордера.
На вкладке "Разработчик" кнопка "Записать макрос"
Таким способом вроде что-то даже получается, я думал может есть более "продвинутый код"
 
 
 
#6
03.08.2022 13:57:52
Код соответствующий формуле из примера. Меня несколько смущает, что формула очень далека от формулировки задачи в сообщении #1.
Код
Sub ВыгрузкаСвод()
    Dim srr As Variant
    Dim vrr As Variant
    srr = Sheets("Свод").UsedRange
    vrr = Sheets("Выгрузка").UsedRange
    
    Dim ys As Long
    For ys = 4 To UBound(srr, 1)
        If srr(ys - 1, 1) = "название работ" Then
            If vrr(ys, 7) = "" Then
                srr(ys, 8) = vrr(ys, 1)
            ElseIf vrr(ys, 7) > 0 Then
                srr(ys, 8) = vrr(ys, 2)
            Else
                srr(ys, 8) = "-"
            End If
        End If
    Next
    
    Sheets("Свод").UsedRange = srr
End Sub
 
 
 
#7
04.08.2022 07:08:52
Денис,
безусловно найдется более продвинутый код, но нужен ли он Вам, чтобы покрыть текущую задачу?
 
 
 
#8
04.08.2022 12:02:38
Цитата
написал:
Код соответствующий формуле из примера. Меня несколько смущает, что формула очень далека от формулировки задачи в сообщении #1.
Код
    [URL=#]?[/URL]       1  2  3  4  5  6  7  8  9  10  11  12  13  14  15  16  17  18  19  20  21      Sub   ВыгрузкаСвод()          Dim   srr   As   Variant          Dim   vrr   As   Variant          srr = Sheets(  "Свод"  ).UsedRange          vrr = Sheets(  "Выгрузка"  ).UsedRange                   Dim   ys   As   Long          For   ys = 4   To   UBound(srr, 1)              If   srr(ys - 1, 1) =   "название работ"   Then                  If   vrr(ys, 7) =   ""   Then                      srr(ys, 8) = vrr(ys, 1)                  ElseIf   vrr(ys, 7) > 0   Then                      srr(ys, 8) = vrr(ys, 2)                  Else                      srr(ys, 8) =   "-"                  End   If              End   If          Next                   Sheets(  "Свод"  ).UsedRange = srr    End   Sub  
 
Спасибо за код!
 
 
 
#9
04.08.2022 12:03:42
evgeniygeo, По методу записи макроса, все даже и получилось! Работает! Но красоту навести охота)))
 
 
 
Страницы: 1
Наверх