Динамические диапазоны

[LaryMusa]

Никак не получается справиться с несколькими проблемками...

Есть экселевский файл, куда добавляются данные по предприятиям. Добавляются данные в виде листов (название листа - "пр-е i" , i=1,..,k). После добавления листа с предприятием необходимо продолжить список на листке, где всё собрано в кучу (листок "банкроты").

Поэтому Вопрос 1. Как можно автоматизировать эту процедуру? Т.е. добавил, например, лист "пр-е 8", а с него данные (по аналогии) идут в листок "банкроты", где всё собрано в кучу.

Вопрос 2. На листке "банкроты" происходит "фильтрация" данных по уровню риска. Отфильтрованные данные надо перенести на следующий лист. Всё бы хорошо, но данные меняются динамически, т.к. могут добавляться новые строчки в конец списка. Как перенести все отфильтрованные данные по-нормальному?

Пробовал использовать имена, но что-то с ними ничего не получается... Пробовал сводные таблицы, но получается хаос
С макросами тоже не особо вышло...

Буду благодарен любой помощи.

[Hugo121]

Здравствуйте.
Во второй части разбираться пока не стал, что-то замороченно очень.
Ну а первую предлагаю делать макросом. При активации листа копируются данные с первых листов. Со всех до Sheets.Count - 2
Полумера - переделал формулы с некоторым запасом, чтоб и считало добавленные, и ошибки и нули не показывало (это условным форматом). Можно конечно их динамически добавлять макросом, но так ли уж надо? Попробуйте сами добавить (мне лениво выписывать эту кучу цифр, тем более, вдруг зря?), и тогда сразу формулу в D2 корректируйте автоматически под новый диапазон.

P.S. 2007-го нет

[LaryMusa]

Hugo121, спасибо большое!
Код сейчас разбираю, есть пища для раздумий!

[Hugo121]

Сейчас подумал - так данные в листе банкротов и соотв. в последнем листе не обновятся, пока не просмотрен лист банкротов.
Может этот код (немного надо будет синтаксис поменять, привязать к листу) поместить на Workbook_SheetActivate с проверкой имени листа - только на два последних, чтоб не тормозило. Тогда можно будет сразу добавить лист и смотреть рейтинг, не проходя по банкротам.

P.S. Там в коде "If iLastRow = 7 Then GoTo 10" - это на случай, если вручную удалите все данные по предприятиям.
Да, и ещё - в конце надо добавить, для красоты:

  Application.CutCopyMode = False
  [d7].Select
Application.ScreenUpdating = True

[LaryMusa]

Сообщение от Hugo121

Сейчас подумал - так данные в листе банкротов и соотв. в последнем листе не обновятся, пока не просмотрен лист банкротов.
Может этот код (немного надо будет синтаксис поменять, привязать к листу) поместить на Workbook_SheetActivate с проверкой имени листа - только на два последних, чтоб не тормозило. Тогда можно будет сразу добавить лист и смотреть рейтинг, не проходя по банкротам.

Именно этого и хотелось в Вопросе 2!


Покопался - вообще перестало работать... Подскажите, пожалуйста, какие строчки надо менять?
VisualBasic только начинаю изучать, поэтому особых успехов пока не видать...

[Hugo121]

Option Explicit

Private Sub Worksheet_Activate()
Dim iLastRow As Long, i As Long
Application.ScreenUpdating = False

 iLastRow = Cells(Rows.Count, 2).End(xlUp).Row
 If iLastRow > 8 Then
 Range(Cells(9, 2), Cells(iLastRow, 6)).ClearContents
10:
 For i = 1 To Sheets.Count - 2
 Cells(i + 8, 2).Value = i
 Cells(i + 8, 3).Value = Sheets(i).Name
 Sheets(i).Range("AG4:AI4").Copy
 Cells(i + 8, 4).PasteSpecial xlPasteValues
 Next
 End If
  iLastRow = Cells(Rows.Count, 2).End(xlUp).Row
  If iLastRow = 7 Then GoTo 10
  Application.CutCopyMode = False
  [d7].Select 'это можно включать, если код в листе "банкроты"
Application.ScreenUpdating = True

End Sub

Вот такой вариант с переводом активной ячейки на D7, только для листа банкротов.
По варианту 2 - туда ведь тоже надо копировать данные, или может сделать сразу таблицу на 100 предприятий - тогда хватит этого одного кода, но выглядеть конечно рейтинг будет иначе
Хотя незадействованные строки можно просто скрыть.

[Hugo121]

Вот вариант на ЭтаКнига:

Option Explicit

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveSheet.Index > Sheets.Count - 2 Then
Application.EnableEvents = False
Dim iLastRow As Long, i As Long, ban As Long
ban = Sheets.Count - 1
Application.ScreenUpdating = False

 iLastRow = Sheets(ban).Cells(Sheets(ban).Rows.Count, 2).End(xlUp).Row
 If iLastRow > 8 Then
 Sheets(ban).Range(Sheets(ban).Cells(9, 2), Sheets(ban).Cells(iLastRow, 6)).ClearContents
10:
 For i = 1 To Sheets.Count - 2
 Sheets(ban).Cells(i + 8, 2).Value = i
 Sheets(ban).Cells(i + 8, 3).Value = Sheets(i).Name
 Sheets(i).Range("AG4:AI4").Copy
 Sheets(ban).Cells(i + 8, 4).PasteSpecial xlPasteValues
 Next
 End If
  iLastRow = Sheets(ban).Cells(Sheets(ban).Rows.Count, 2).End(xlUp).Row
  If iLastRow = 7 Then GoTo 10
  Application.CutCopyMode = False
  [d7].Select 'это можно включать, если код в листе "банкроты", хотя и в  "рейтинге" сильно не мешает
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End Sub

Данные в "банкроты" копируются только при активации любого их двух последних листов. Но правда при каждой активации, будет немного подёргивать...

[Hugo121]

Так, убрал копирование значений, теперь дёргает меньше
Не бойтесь, заменил на присвоение

Option Explicit

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveSheet.Index > Sheets.Count - 2 Then
Application.EnableEvents = False
Dim iLastRow As Long, i As Long, ban As Long
ban = Sheets.Count - 1
Application.ScreenUpdating = False

 iLastRow = Sheets(ban).Cells(Sheets(ban).Rows.Count, 2).End(xlUp).Row
 If iLastRow > 8 Then
 Sheets(ban).Range(Sheets(ban).Cells(9, 2), Sheets(ban).Cells(iLastRow, 6)).ClearContents
10:
 For i = 1 To Sheets.Count - 2
 Sheets(ban).Cells(i + 8, 2).Value = i
 Sheets(ban).Cells(i + 8, 3).Value = Sheets(i).Name
 Sheets(ban).Cells(i + 8, 4) = Sheets(i).Cells(4, 33)
 Sheets(ban).Cells(i + 8, 5) = Sheets(i).Cells(4, 34)
 Sheets(ban).Cells(i + 8, 6) = Sheets(i).Cells(4, 35)
 Next
 End If
  iLastRow = Sheets(ban).Cells(Sheets(ban).Rows.Count, 2).End(xlUp).Row
  If iLastRow = 7 Then GoTo 10
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End Sub

Плюс ещё в одном месте был косячок (вверху так было: iLastRow = Sheets(ban).Cells(Rows.Count, 2).End(xlUp).Row, я сейчас пост подправил). Хотя я не знаю, может ли вообще быть разное количество строк на разных листах одной книги? Ну лучше пере.., чем недо...

[LaryMusa]

Ух, ты! Спасибо!!!
Правда, сейчас нет возможности посмотреть как что работает, но руки так и чешутся опробовать эти команды