Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Макрос переноса строки. (По кнопке) - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос переноса строки. (По кнопке) (Макросы/Sub)
Макрос переноса строки. (По кнопке)
cheapset Дата: Понедельник, 17.08.2020, 16:04 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 1
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
Здравствуйте! Имеется макрос:

[vba]
Код
Sub Перенос()
Dim c As Range
Dim lr1 As Long, lr2 As Long
Dim a()
    lr1 = Cells(Rows.Count, 2).End(xlUp).Row 'находим номер последней строки на листе орк
    With Sheets("Маршрутные листы.") 'с листом "Маршрутные листы."
        lr2 = .Cells(Rows.Count, 4).End(xlUp).Row + 1 'находим номер последней строки на листе "Маршрутные листы." + 1
        .Cells(lr2, 5) = Date 'ставим дату разделитель
        lr2 = lr2 + 1 'увеличиваем номер строки
        For Each c In Range("B2:B" & lr1) 'для всех ячеек в диапазоне ...
            If c.Interior.ColorIndex = RGB(191, 191, 191) Then 'если заливка серый то
                a = Range("B" & c.Row & ":H" & c.Row) 'вносим в массив диапазон
                .Cells(lr2, 1).Resize(1, 7) = a 'копируем строку на лист "Маршрутный лист."
                .Cells(lr2, 8) = Date 'ставим дату в последнюю колонку
                lr2 = lr2 + 1 'увеличиваем номер строки
            End If
        Next
    End With
    For i = lr To 3 Step -1 'от последней строки до 3й с шагом -1
        If Cells(i, 2).Interior.ColorIndex = RGB(191, 191, 191) Then 'если заливка серый то
            Rows(i).Delete 'строку удаляем
        End If
    Next
    'Call Сортировка
End Sub
[/vba]

Прикладываю образцы для наглядности. На данном этапе , макрос переносит строки по последней, каждую строку в свой диапазон. Необходимо выполнить перенос по ДВУМ условиям:

- Дата отгрузки
- Имя водителя
Во втором образце я пробовал через расширенный фильтр, но остановился на том, что не получится свои строки в свой диапазон вставить.

Т.е. Выбрав на листе "Заказы" дату отгрузки и водителя, нужно, что бы она была связана с формулой "=Сегодня" на "Маршрутном листе" и с нужным диапазоном соответствующего водителя.

Прошу подмоги.
К сообщению приложен файл: 6394923.rar(60.3 Kb)


Сообщение отредактировал cheapset - Понедельник, 17.08.2020, 16:13
 
Ответить
СообщениеЗдравствуйте! Имеется макрос:

[vba]
Код
Sub Перенос()
Dim c As Range
Dim lr1 As Long, lr2 As Long
Dim a()
    lr1 = Cells(Rows.Count, 2).End(xlUp).Row 'находим номер последней строки на листе орк
    With Sheets("Маршрутные листы.") 'с листом "Маршрутные листы."
        lr2 = .Cells(Rows.Count, 4).End(xlUp).Row + 1 'находим номер последней строки на листе "Маршрутные листы." + 1
        .Cells(lr2, 5) = Date 'ставим дату разделитель
        lr2 = lr2 + 1 'увеличиваем номер строки
        For Each c In Range("B2:B" & lr1) 'для всех ячеек в диапазоне ...
            If c.Interior.ColorIndex = RGB(191, 191, 191) Then 'если заливка серый то
                a = Range("B" & c.Row & ":H" & c.Row) 'вносим в массив диапазон
                .Cells(lr2, 1).Resize(1, 7) = a 'копируем строку на лист "Маршрутный лист."
                .Cells(lr2, 8) = Date 'ставим дату в последнюю колонку
                lr2 = lr2 + 1 'увеличиваем номер строки
            End If
        Next
    End With
    For i = lr To 3 Step -1 'от последней строки до 3й с шагом -1
        If Cells(i, 2).Interior.ColorIndex = RGB(191, 191, 191) Then 'если заливка серый то
            Rows(i).Delete 'строку удаляем
        End If
    Next
    'Call Сортировка
End Sub
[/vba]

Прикладываю образцы для наглядности. На данном этапе , макрос переносит строки по последней, каждую строку в свой диапазон. Необходимо выполнить перенос по ДВУМ условиям:

- Дата отгрузки
- Имя водителя
Во втором образце я пробовал через расширенный фильтр, но остановился на том, что не получится свои строки в свой диапазон вставить.

Т.е. Выбрав на листе "Заказы" дату отгрузки и водителя, нужно, что бы она была связана с формулой "=Сегодня" на "Маршрутном листе" и с нужным диапазоном соответствующего водителя.

Прошу подмоги.

Автор - cheapset
Дата добавления - 17.08.2020 в 16:04
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос переноса строки. (По кнопке) (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2020 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!