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

Вход

Регистрация

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

 

= Мир MS Excel/Копирование при фильтре - VBA - Мир MS Excel

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

Excel 2016
Нужно при нажатии кнопки скопировать из листа даные на лист сводная таблица согласно числу смены и месяца.... Поидеи будет прежде делаться фильт по месяцу, так что месяц будет один, а вот числа и смены разные... как мне скопировать согласно фильтра, ибо там пропущеные строки при фильтрации (2,4,5- 3 пропущена) и оно должно выборку делать именно из отфильтрованного списка и копировать время согласно смены и числу...
и копировать должно построчно, не пойму ещё как люди делают функцию подсчета заполнености строки, а у меня будет куча поломок по сменно и должно скопировать тип поломки а время вставить согласно смены и числу... и в начале макроса необходимо очищать всю таблицу для того чтоб новые значения по фильтру не путались со старыми...
Вот есть что-то похожее, но оно копирует на листы... а мне надо с фильтра, с учетом пропущеных строк и согласно выборке
ПРИМЕР:
Option Explicit ' Обязательное объявление переменных
Option Compare Text ' отсутствие чувствительности к регистру при сравнении символов

Sub Raspredelenie_po_listam()
Const FirstRow& = 7 ' Константа - первая строка данных ниже шапки на всех листах
Dim i&, j&, LastRow&, LastRowTarget&, ShName, Sh_Target As Worksheet, Prefix$, FormulaRC$, A
Application.ScreenUpdating = False ' Временное отключение обновления экрана в Excel
For Each ShName In Array("Лист2", "Лист3", "Лист4") ' Цикл по 3 листам с результатами для очистки старых данных
With Sheets(ShName) ' Работа с объектом Sheet через символ "."
LastRowTarget = .Cells(.Rows.Count, "Z").End(xlUp).Row ' Определение последней заполненной строки по столбцу Z
If LastRowTarget < FirstRow Then LastRowTarget = FirstRow ' последняя заполненная строка не должна быть меньше FirstRow (=7)
.Rows(FirstRow & ":" & LastRowTarget).Clear ' Удаление строк со старыми данными при новом распределении
End With
Next ShName
With Лист1 ' Работа с объектом Лист1 (программное имя объекта) через символ "."
LastRow = .Cells(.Rows.Count, "Z").End(xlUp).Row ' Определение последней заполненной строки по столбцу Z
Prefix = "=" & Лист1.Name & "!R" ' Первая часть ссылочных формул
A = .Range(.Cells(1, 1), .Cells(LastRow, 15)).Value ' Формируем массив для проверки условий
For i = FirstRow To LastRow ' Цикл по строкам анализируемого листа
A(i, 8) = Trim(A(i, 8)) ' удаление пробелов спереди и сзади в элементах 8-го столбца массива
A(i, 15) = Trim(A(i, 15))
If A(i, 8) = "ЗБС" Or A(i, 8) = "ВНС" Then ' Комплекс условий 1
Set Sh_Target = Лист2 ' Объектная ссылка на лист цель.
ElseIf (A(i, 8) = "Конс" Or A(i, 8) = "Раск") And A(i, 15) = "Я" Then ' Комплекс условий 2
Set Sh_Target = Лист3 ' Объектная ссылка на лист цель.
Else ' если не выполняется ни 1-ый ни 2-ой комлекс условий
Set Sh_Target = Лист4 ' Объектная ссылка на лист цель.
End If
.Range(.Cells(i, 1), .Cells(i, "AU")).Copy ' копирование i-той строки (по AU,для последующей вставки форматов)
FormulaRC = Prefix & Format(i) & "C" ' 2-я часть ссылочной формулы
With Sh_Target ' Работа с объектом листом-целью, куда копируем форматы, через символ "."
LastRowTarget = .Cells(.Rows.Count, "Z").End(xlUp).Row + 1 ' Определение последней пустой строки по столбцу Z
If LastRowTarget < FirstRow Then LastRowTarget = FirstRow
.Cells(LastRowTarget, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' вставка скопированных форматов
.Rows(LastRowTarget).RowHeight = Лист1.Rows(i).RowHeight ' Выравнивание высоты строки по исходной
.Range(.Cells(LastRowTarget, 1), .Cells(LastRowTarget, "AU")).FormulaR1C1 = FormulaRC ' заполнение целевого диапазона ссылочными формулами
End With
Next i
End With
Set Sh_Target = Nothing ' Очистка памяти от объектных ссылок
End Sub
К сообщению приложен файл: 8919116.xlsx(12.4 Kb)
 
Ответить
СообщениеНужно при нажатии кнопки скопировать из листа даные на лист сводная таблица согласно числу смены и месяца.... Поидеи будет прежде делаться фильт по месяцу, так что месяц будет один, а вот числа и смены разные... как мне скопировать согласно фильтра, ибо там пропущеные строки при фильтрации (2,4,5- 3 пропущена) и оно должно выборку делать именно из отфильтрованного списка и копировать время согласно смены и числу...
и копировать должно построчно, не пойму ещё как люди делают функцию подсчета заполнености строки, а у меня будет куча поломок по сменно и должно скопировать тип поломки а время вставить согласно смены и числу... и в начале макроса необходимо очищать всю таблицу для того чтоб новые значения по фильтру не путались со старыми...
Вот есть что-то похожее, но оно копирует на листы... а мне надо с фильтра, с учетом пропущеных строк и согласно выборке
ПРИМЕР:
Option Explicit ' Обязательное объявление переменных
Option Compare Text ' отсутствие чувствительности к регистру при сравнении символов

Sub Raspredelenie_po_listam()
Const FirstRow& = 7 ' Константа - первая строка данных ниже шапки на всех листах
Dim i&, j&, LastRow&, LastRowTarget&, ShName, Sh_Target As Worksheet, Prefix$, FormulaRC$, A
Application.ScreenUpdating = False ' Временное отключение обновления экрана в Excel
For Each ShName In Array("Лист2", "Лист3", "Лист4") ' Цикл по 3 листам с результатами для очистки старых данных
With Sheets(ShName) ' Работа с объектом Sheet через символ "."
LastRowTarget = .Cells(.Rows.Count, "Z").End(xlUp).Row ' Определение последней заполненной строки по столбцу Z
If LastRowTarget < FirstRow Then LastRowTarget = FirstRow ' последняя заполненная строка не должна быть меньше FirstRow (=7)
.Rows(FirstRow & ":" & LastRowTarget).Clear ' Удаление строк со старыми данными при новом распределении
End With
Next ShName
With Лист1 ' Работа с объектом Лист1 (программное имя объекта) через символ "."
LastRow = .Cells(.Rows.Count, "Z").End(xlUp).Row ' Определение последней заполненной строки по столбцу Z
Prefix = "=" & Лист1.Name & "!R" ' Первая часть ссылочных формул
A = .Range(.Cells(1, 1), .Cells(LastRow, 15)).Value ' Формируем массив для проверки условий
For i = FirstRow To LastRow ' Цикл по строкам анализируемого листа
A(i, 8) = Trim(A(i, 8)) ' удаление пробелов спереди и сзади в элементах 8-го столбца массива
A(i, 15) = Trim(A(i, 15))
If A(i, 8) = "ЗБС" Or A(i, 8) = "ВНС" Then ' Комплекс условий 1
Set Sh_Target = Лист2 ' Объектная ссылка на лист цель.
ElseIf (A(i, 8) = "Конс" Or A(i, 8) = "Раск") And A(i, 15) = "Я" Then ' Комплекс условий 2
Set Sh_Target = Лист3 ' Объектная ссылка на лист цель.
Else ' если не выполняется ни 1-ый ни 2-ой комлекс условий
Set Sh_Target = Лист4 ' Объектная ссылка на лист цель.
End If
.Range(.Cells(i, 1), .Cells(i, "AU")).Copy ' копирование i-той строки (по AU,для последующей вставки форматов)
FormulaRC = Prefix & Format(i) & "C" ' 2-я часть ссылочной формулы
With Sh_Target ' Работа с объектом листом-целью, куда копируем форматы, через символ "."
LastRowTarget = .Cells(.Rows.Count, "Z").End(xlUp).Row + 1 ' Определение последней пустой строки по столбцу Z
If LastRowTarget < FirstRow Then LastRowTarget = FirstRow
.Cells(LastRowTarget, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' вставка скопированных форматов
.Rows(LastRowTarget).RowHeight = Лист1.Rows(i).RowHeight ' Выравнивание высоты строки по исходной
.Range(.Cells(LastRowTarget, 1), .Cells(LastRowTarget, "AU")).FormulaR1C1 = FormulaRC ' заполнение целевого диапазона ссылочными формулами
End With
Next i
End With
Set Sh_Target = Nothing ' Очистка памяти от объектных ссылок
End Sub

Автор - aastg2016
Дата добавления - 13.04.2018 в 01:21
Pelena Дата: Пятница, 13.04.2018, 09:11 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 13109
Репутация: 2888 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
aastg2016, оформите код тегами с помощью кнопки # в режиме правки поста


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
Сообщениеaastg2016, оформите код тегами с помощью кнопки # в режиме правки поста

Автор - Pelena
Дата добавления - 13.04.2018 в 09:11
aastg2016 Дата: Пятница, 13.04.2018, 11:03 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, я в экселе новичек... мне бы примр....
 
Ответить
СообщениеPelena, я в экселе новичек... мне бы примр....

Автор - aastg2016
Дата добавления - 13.04.2018 в 11:03
китин Дата: Пятница, 13.04.2018, 11:05 | Сообщение № 4
Группа: Модераторы
Ранг: Участник клуба
Сообщений: 5071
Репутация: 807 ±
Замечаний: 0% ±

Excel 2007;Excel 2010


Не судите строго:я пытаюсь научиться
ЯД 41001877306852/WM R249698041931; Z239672726538
 
Ответить
Сообщениеaastg2016,
Как оформлять сообщения?

Автор - китин
Дата добавления - 13.04.2018 в 11:05
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование при фильтре - VBA (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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