Создание макроса

[Lelik)]

Форумчане, помогите, плиз.
Задача стоит такая: написать макрос для обработки реестра. На первой странице книги список листов со ссылками на соответсвующие листы. Необходимо зайти на каждый лист скопировать данные с 8 строки до конца таблицы, вставить на отдельный лист и таким образом сформировать список. На каждом листе в ячейке (7,1) подсчитано количество строк.
Написан макрос, который на 120 объектах работает замечательно, а дальше начинаются глюки...копирует несколько раз данные с какого-нибудь листа.

Sub selected()
Dim n As Variant, IRow As Variant, b As Variant, c As Variant, i As Variant
If IsArray(Selection) = False Then GoTo Line1 Else
Set arr = Selection
leng = arr.Rows.Count
IRow = Selection.Row
b = Selection.Column
Worksheets.Add.Name = "Результат"
c = 0
For i = 1 To leng
Sheets("Реестр для сайта").Select
Cells(IRow + i - 1, b).Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Cells(7, 1).Select
Selection.Value = Selection.Value
n = Cells(7, 1)
If n > 0 Then
Range(Cells(8, 1), Cells(8 + n - 1, 10)).Copy: Sheets("Результат").Select: ActiveSheet.Paste Destination:=Worksheets("Результат" ).Range(Cells(c + 1, 1), Cells(c + n, 10))
ElseIf n = 0 Then
Sheets("Реестр для сайта").Select
End If
c = c + n
Next i
GoTo LastLine
Line1:
MsgBox ("Выберите диапазон")
LastLine:
End Sub

Файл для обработки можно скачать тут: http://gov.spb.ru/gov/otrasl/inspekc...-po-upravleniy...
вторая ссылка Реестр лицензий субъекта Российской Федерации - «Санкт-Петербург»

[Aleksandr H.]

Интересно стало что там за файл такой на 120+ листов, но... поприветствовала 404 страница.

[IgorGO]

в техническом описании ексел написано, что количество страниц в книге ограничено только обьемом оперативной памяти
т.е. их может быть много, но все-таки ограничено

если я в книге вижу больше 5 листов - я уже пугаюсь, а книги с более, чем 10 листов стараюсь вообще не открывать

[EducatedFool]

копирует несколько раз данные с какого-нибудь листа.

поскольку файл скачать и посмотреть возможности нет, 2 предположения:

1) есть скрытые строки с дубликатами данных (макрос цепляет данные из скрытых строк)
2) аналогично, только есть скрытые не строки, и листы

PS: макрос, конечно, оставляет желать лучшего, - но там не видно ничего такого, что вдруг начало бы зацикливаться на конкретном листе

[Lelik)]

Сообщение от Aleksandr H.

Интересно стало что там за файл такой на 120+ листов, но... поприветствовала 404 страница.

Там реестр управляющих компаний Санкт-Петербурга и списки обслуживаемых ими многоквартирных домов. Реестр на 409 страниц и все время обновляется. На каждой странице домов от 0 до 1000.

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

в техническом описании ексел написано, что количество страниц в книге ограничено только обьемом оперативной памяти
т.е. их может быть много, но все-таки ограничено

если я в книге вижу больше 5 листов - я уже пугаюсь, а книги с более, чем 10 листов стараюсь вообще не открывать

т.е. предлагаете обрабатывать файл по частям?

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

поскольку файл скачать и посмотреть возможности нет, 2 предположения:

1) есть скрытые строки с дубликатами данных (макрос цепляет данные из скрытых строк)
2) аналогично, только есть скрытые не строки, и листы

PS: макрос, конечно, оставляет желать лучшего, - но там не видно ничего такого, что вдруг начало бы зацикливаться на конкретном листе

Спасибо, проверила скрытых строк с дубликатами и скрытых листов нет.
На небольшом примере работает на ура, виснет именно при обработке всего файла. Файл сократила до 150 листов и он помещается во вложении. Глючить начинает на 147 листе, несколько раз вставляет с него данные. При удачной обработке 150 листов в результирующем списке должно получиться 17 283 строки. А получается 17 866.

[Lelik)]

Уважаемые,
попытка обработать файл по частям ни к чему хорошему не привела. Попробовала обработать всего 4 страницы, начиная с 147 по 150, макрос 4 раза вставил в список данные с 147 страницы соответственно числу страниц(((

в чем может быть ошибка?

вроде 4 страницы не такой большой объем данных для обработки....страницы с 1 по 146 были предварительно удалены.

[EducatedFool]

Если запустить такой макрос:

Sub selected_test()
    Dim n As Variant, IRow As Variant, b As Variant, c As Variant, i As Variant
    Set arr = Selection
    leng = arr.Rows.Count
    IRow = Selection.Row
    b = Selection.Column
    For i = 1 To leng
        Sheets("Реестр для сайта").Select
        Cells(IRow + i - 1, b).Select
        'Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True

        ' вместо перехода по ссылке, посмотрим, что это за ссылка...
        Debug.Print "Адрес ячейки: " & Selection.Address & ", текст ячейки: """ & _
                    Selection.Text & """, ссылка на "; Selection.Hyperlinks(1).SubAddress
    Next i
End Sub

то проблема сразу становится видна:

Адрес ячейки: $AA$145, текст ячейки: "Список МКД 140", ссылка на '140'!A1
Адрес ячейки: $AA$146, текст ячейки: "Список МКД 141", ссылка на '142'!A1
Адрес ячейки: $AA$147, текст ячейки: "Список МКД 142", ссылка на '142'!A1
Адрес ячейки: $AA$148, текст ячейки: "Список МКД 143", ссылка на '143'!A1
Адрес ячейки: $AA$149, текст ячейки: "Список МКД 144", ссылка на '144'!A1
Адрес ячейки: $AA$150, текст ячейки: "Список МКД 145", ссылка на '145'!A1
Адрес ячейки: $AA$151, текст ячейки: "Список МКД 146", ссылка на '146'!A1
Адрес ячейки: $AA$152, текст ячейки: "Список МКД 147", ссылка на '147'!A1
Адрес ячейки: $AA$153, текст ячейки: "Список МКД 148", ссылка на '147'!A1
Адрес ячейки: $AA$154, текст ячейки: "Список МКД 149", ссылка на '147'!A1
Адрес ячейки: $AA$155, текст ячейки: "Список МКД 150", ссылка на '147'!A1

Вывод:
надо не ссылки перебирать (которые криво сделаны, - видимо, путем копирования),
и перебирать в цикле ЛИСТЫ файла

Правильный макрос будет выглядеть так:

Sub test()
    Dim sh As Worksheet, ra As Range, sh_res As Worksheet
    Application.ScreenUpdating = False

    Set sh_res = ActiveWorkbook.Worksheets.Add        ' создаём лист результата
    sh_res.Name = "Результат от " & Format(Now, "dd.mm.yy hh-nn-ss")

    For Each sh In ActiveWorkbook.Worksheets        ' перебираем все листы в цикле
        If IsNumeric(sh.Name) Then        ' если название листа - числовое, то
            ' получаем диапазон с данными с очередного листа
            Set ra = Nothing: Set ra = sh.Range(sh.Range("a8"), sh.Range("a" & sh.Rows.Count).End(xlUp)).Resize(, 10)
            ' если диапазон на листе непустой, - вставляем на лист результата, начиная с первой пустой строки
            If ra.Row = 8 Then ra.Copy sh_res.Range("a" & sh.Rows.Count).End(xlUp).Offset(1)
        End If
    Next sh
    
    sh_res.UsedRange.EntireColumn.AutoFit ' автоподбор ширины столбцов
    Application.ScreenUpdating = True
End Sub

[IgorGO]

откройте файл
нажмите кнопку
навесьте фильтр на полученную таблицу
фильтруйте по 1-й колонке

простыми манипуляциями можете получить сводную (если она Вам нужна)

[Lelik)]

Ох, да! Спасибо огромное, Великий Гуру VBA!!
А я то на ссылки щелкаю и самое интересное,что они идут на правильные листы....
Все отлично срабатывает!!!! Это гениально!!!)))))
Еще раз ОГРОМНОЕ СПАСИБО!!!))))

[Lelik)]

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

откройте файл
нажмите кнопку
навесьте фильтр на полученную таблицу
фильтруйте по 1-й колонке

простыми манипуляциями можете получить сводную (если она Вам нужна)

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