Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Автоматизация группировки строк, Нужна помощь в автоматизации группировки большого количества строк
 
#1
06.01.2020 15:42:18
Добрый день!
Коллеги, нужна помощь в создании макроса для автоматизации группировки строк в таблице. Помогите, пожалуйста, кто знает.
Задача следующая. Есть таблица с одним столбцом. В этой таблице около 500 тысяч строк. В ней содержатся блоки информации с разным количеством строк, от одной до 30-ти (примерно). Все блоки разделены пустой строкой. Таких блоков информации около 10-ти тысяч. Нужно сгруппировать строки каждого блока отдельно. При этом первая строка каждого блока должна остаться видимой, а пустая строка - прятаться в группу. Чтобы было понятнее, я прикрепил файл с примером. На Листе1 - отрывок из исходного файла, на Листе2 - желаемый результат, сделанный вручную.
Конечно, это все можно сделать руками, но 10 тысяч группировок - многовато... ((
Заранее благодарю за помощь!
 
 
 
#2
06.01.2020 23:10:35
Ну почему работу, которую нужно сделать за Вас, Вы (и не только Вы) называете помощью?
 
 
 
#3
07.01.2020 00:03:15
Всегда ли слово "Турецкий" будет маркером начала блока данных ?
 
 
 
#4
07.01.2020 00:12:42
Politeperson, написал
Цитата
на Листе2 - желаемый результат, сделанный вручную.
У меня и вручную так не получается. Как вы это сделали?
У меня только так
Код
Sub iGroup()
Dim Rng As Range
Dim iLastRow As Long
Application.ScreenUpdating = False
  iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    For Each Rng In Range("A1:A" & iLastRow).SpecialCells(xlCellTypeConstants, 2).Areas
      Rng.Offset(1).Rows.Group
    Next
Application.ScreenUpdating = True
End Sub
 
 
 
#5
07.01.2020 00:43:19
Цитата
Юрий М написал:
Ну почему работу, которую нужно сделать за Вас, Вы (и не только Вы) называете помощью?
Потому что я полагаю, что для специалистов, которые здесь имеются, эта задачка - плёвое дело. И они могут её решить за 1 минуту. Но я к таким не отношусь, это не моя специализация. Мне нужно решить эту проблему, чтобы двигаться дальше в своем направлении. Да, я могу разобраться сам, вникнуть во все нюансы, но я потрачу на это кучу времени. Когда ко мне придет новичок и спросит, как создать рекламный кабинет в ФБ, я ему с радостью расскажу.
По всей видимости, Вы считаете, что ответить спросившему человеку, который час, это тоже работа.
Я никого не заставляю решать эту проблему. Я просто задал вопрос. Если человек захочет мне помочь по какой-то причине (для закрепления навыков или просто из альтруистических побуждений), я буду очень благодарен, если нет - на всё Божья воля. Не всё в нашем мире измеряется деньгами.
Изменено: Politeperson - 07.01.2020 00:54:30
 
 
 
#6
07.01.2020 00:50:57
Вариант2
Код
Sub iGroup1()
Dim iLastRow As Long, i As Long
Application.ScreenUpdating = False
ActiveSheet.Outline.SummaryRow = xlAbove
  iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To iLastRow
    If Cells(i, 1) <> "" Then
    Rows(i + 1).Group
    End If
    Next
Application.ScreenUpdating = True
End Sub
 
 
 
#7
07.01.2020 01:14:16
Цитата
ocet p написал:
Всегда ли слово "Турецкий" будет маркером начала блока данных ?
Нет. Не всегда. Так в примере совпало просто.
 
 
 
#8
07.01.2020 01:15:44
Цитата
Kuzmich написал:
У меня только так
Спасибо. Попробую.
 
 
 
#9
07.01.2020 01:19:44
Цитата
gling написал:
Вариант2
Спасибо! А я уже почти "приспособил" Ваш макрос из этого сообщения. ) Правда, пришлось немного изменить саму таблицу (разбить на столбцы) и исправить числа в коде. Плюс, долго не мог найти, каким символом обозначается НЕпустая ячейка.  
Изменено: Politeperson - 07.01.2020 01:23:36
 
 
 
#10
07.01.2020 03:03:13
Kuzmich, gling, спасибо Вам огромное! Очень выручили! Оба кода работают, как часики.

Друзья, форумчане, поздравляю всех с Рождеством Христовым! Всех вам благ!
 
 
 
#11
07.01.2020 03:46:31
Цитата
Politeperson написал:
но я потрачу на это кучу времени
:sceptic: ... И как это связано с саморазвитием и самообразованием ?

Пожалуйста, "Вариант 3":
Код
Option Explicit

Sub zyx_cba()
    With ThisWorkbook.Sheets("Лист1").Range("A1")
        .ClearOutline
        .Select
    End With
End Sub

Sub abc_xyz()
    Dim rn&, rk&, rws&
    rk = 0: rn = 0: rws = Cells(Rows.Count, "A").End(xlUp).Row
    Application.ScreenUpdating = False
    With ThisWorkbook.Sheets("Лист1").Columns("A")
        Do Until rk > rws
            rn = rk + 1
            rk = .Range("A" & rn).End(xlDown).Row + 1
            .Rows(rk & ":" & rn + 1).Rows.Group
            .Rows(rk & ":" & rn + 1).Hidden = True
        Loop
    End With
    Application.ScreenUpdating = True
End Sub
Интересно, будет ли это работать у вас (из-за кириллицы) или нет ?
 
 
 
#12
07.01.2020 10:58:25
Off
Цитата
Politeperson написал: Потому что я полагаю, что для специалистов, которые здесь имеются, эта задачка - плёвое дело...
Когда ко мне придет новичок и спросит, как создать рекламный кабинет в ФБ, я ему с радостью расскажу...
Не всё в нашем мире измеряется деньгами.
по этой логике я могу пойти к хирургу и попросить рассказать, как  делается лоботомия, а потом начать практиковать , при этом даром.

Вы не поняли слов Юрий М. помощь - даже по определению - содействие кому-либо или чему-либо. Если говорить о итоговой задачи, да, наверно это содействие сделать за вас часть работы, которую вы не можете сделать самостоятельно, но конкретно эта задача сделанная за вас - сделана за вас и не иначе.
Цитата
Politeperson написал: чтобы двигаться дальше в своем направлении
- а что это для вас означает?  вы тоже альтруист?
По вопросам из тем форума, личку не читаю.
 
 
 
#13
07.01.2020 11:40:30
Цитата
БМВ написал: Вы не поняли слов  Юрий М . помощь
Совершенно верно!
Politeperson,  я Вам писал исключительно про формулировку. - это не помощь.
 
 
 
#14
07.01.2020 12:27:17
Politeperson, свои сообщения можно дополнять, не создавать очереди
 
 
 
Страницы: 1
Наверх