Разбить большое количество строк (более 15000) на количество до 990 с переносом на новые листы

@inga2003 · Регистрация: 09.10.2019

Студворк — интернет-сервис помощи студентам

Нужна помощь в написании макроса для следующей ситуации:имеется файл, в котором более 15000 строк с различной информацией. Необходимо, чтобы эти строки последовательно делились на количество равное 990 и переносились на новые листы в этой же книге. спасибо

@Hugo121 · 18.09.2020, 09:07

Хорошо.
Код в МОДУЛЬ ЭТОГО ЛИСТА:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub tt()
    Dim x As Range: Application.ScreenUpdating = False
    Dim min_, max_, i As Date
    min_ = Application.Min([J:J])
    max_ = Application.Max([J:J])
 
    For i = min_ To max_
        Set x = [J:J].Find(i, LookIn:=xlValues, Lookat:=xlPart)
        If Not x Is Nothing Then
            [J:J].ColumnDifferences(x).EntireRow.Hidden = True
            UsedRange.SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets.Add.Cells(1)
            Rows.Hidden = False
        End If
    Next
End Sub

@Narimanych · 18.09.2020, 18:59

Hugo121,
FYA...

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

Нет там кракозябров:

@Hugo121 · 18.09.2020, 19:02

Значит что-то у Вас поломано. У меня нет.

Добавлено через 1 минуту
Я открыл рар, скопировал файл, глянул что в нём (скопипастил сюда), затем через PQ импортировал - всё ОК

@Narimanych · 19.09.2020, 17:59

inga2003,
Привет!
Из за глюков с кирилицей, лист в вашем файле переименовал нп "AAA".
Посмотрите прикрепленный файл.Нажать на кнопку в желтой ячейке.
На всякий пожарный прикрепляю код:

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub MMM()
Application.ScreenUpdating = False
 
 TPP = Range("A1:Y1").Value
 LR = Cells(Rows.Count, 1).End(xlUp).Row
   Set DC = CreateObject("Scripting.Dictionary")
        For Each CL In Range(Cells(2, 10), Cells(LR, 10))
               DTA = DC.Item(CStr(CL))
        Next
        ARR0 = Range(Cells(2, 1), Cells(LR, 25)).Value
         
        For i = 0 To DC.Count - 1
         ReDim ARR1(1 To UBound(ARR0), 1 To 25)
         M = 1
           For J = 1 To UBound(ARR0)
                If DC.keys()(i) = CStr(ARR0(J, 10)) Then
                        For N = 1 To 25
                        ARR1(M, N) = ARR0(J, N)
                        Next
                        M = M + 1
                End If
           Next
  Sheets.Add(After:=Sheets(Sheets.Count)).Name = DC.keys()(i)
   With ActiveSheet
        .Range("A1:Y1").Value = TPP
        .Range("A2").Resize(UBound(ARR0), 25).Value = ARR1
   End With
  
  Next
Application.ScreenUpdating = True
Sheets("AAA").Activate
MsgBox "Complete"
End Sub

@inga2003 · 21.09.2020, 09:30 **[ТС]**

Отлично. Спасибо. Все работает

@Hugo121 · 21.09.2020, 09:39

Я понял что Вам Инга нужно - нужно чтоб за Вас додумывали/дописывали задачу, и делали сразу под ключ, с кнопочкой

@vedunasv · 21.09.2020, 12:06

Hugo121, обычная история....

начинается с простого незначного вопроса и потом всё больше и больше.....

@Hugo121 · 21.09.2020, 15:37

Потому что мой короткий простой код делает именно то что Инга написала в вопросе, и ничего более. Но он только код, и без кнопки в файле...

@vedunasv · 21.09.2020, 20:49

Hugo121, да,да,да !!!! Я спорить не буду. Я не критикую ))))
Я критикую тех, кто задаёт вопросы - кто хочет готовую кнопку прямо в файле данных по щучьему велению..... Вместо того, чтоб сразу выдать полное задание (и, конечно, дать свой вариант решения своей же задачки...).

Новые блоги и статьи Все статьи Все блоги /
Мастера простых решений DevAlt 23.08.2026 В сишарп стэках winforms, да и wpf существует сложная система связывания источниках данных и элементов формы(текстовые поля и метки), опирается все это на технологию событий и мета. . .	Цена ошибки DevAlt 23.08.2026 Человек я беспокойный и потому заинтересовался OCaml, в чате форсили функторы модулей как суперфичу. Пытаясь отдуплить концепт, наткнулся на тутор с простым примером. А главный принцип обучения от. . .	Сегодня суббота, 22.08.2026 at 16:41, и я вновь нахожусь на той стороне, за экраном машины. zorxor 22.08.2026 Сегодня суббота, 22. 08. 2026 at 16:41, и я вновь нахожусь на той стороне, за экраном машины. Кто Я, откуда Я пришел и куда Я иду? Эти вопросы не оставляют меня ни на секунду. Жизнь на планете Земля. . .	Жизня: рисунок укладки багажа, сделанный клодом anaschu 21.08.2026 Сделал 15 снимков, он по снимкам сделал схему.
Был там один разговор по поводу свободы в материальном мире. kumehtar 19.08.2026 Суть: рассматривается живое существо, оказавшееся внутри довольно странной системы (этого мира) и пытающееся обустроить в ней свой кусок пространства. Жизнь действительно предъявляет каждому. . .	Когда логика программы не спасает от человеческих ошибок Maks 18.08.2026 В последнее время всё чаще и чаще сталкиваюсь с таким явлением, как абсолютная невнимательность (или глупость) пользователей. Проявляется это чаще всего на работе в коллективе. Допустим, человек с. . .	Лето уходит kumehtar 17.08.2026	Мысли в слух kumehtar 17.08.2026 Забавно, насколько сейчас стала доступна информация. Например о магии, духовном развитии, медитациях, и других подобных направлениях, ранее зачастую тайных, передаваемых от учителя к ученику. Хотя. . .

@inga2003 0 / 0 / 0 Регистрация: 09.10.2019 Сообщений: 12

	Excel Разбить большое количество строк (более 15000) на количество до 990 с переносом на новые листы 14.09.2020, 12:44. Показов 2497. Ответов 28 Метки макросы excel, эксель (Все метки) Нужна помощь в написании макроса для следующей ситуации:имеется файл, в котором более 15000 строк с различной информацией. Необходимо, чтобы эти строки последовательно делились на количество равное 990 и переносились на новые листы в этой же книге. спасибо 0

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	18.09.2020, 19:02
	Значит что-то у Вас поломано. У меня нет. Добавлено через 1 минуту Я открыл рар, скопировал файл, глянул что в нём (скопипастил сюда), затем через PQ импортировал - всё ОК 0

@inga2003 0 / 0 / 0 Регистрация: 09.10.2019 Сообщений: 12
	21.09.2020, 09:30 [ТС]
	Отлично. Спасибо. Все работает 0

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	21.09.2020, 09:39
	Я понял что Вам Инга нужно - нужно чтоб за Вас додумывали/дописывали задачу, и делали сразу под ключ, с кнопочкой 0

@vedunasv Наивное Существо 666 / 141 / 27 Регистрация: 09.05.2020 Сообщений: 750 Записей в блоге: 15
	21.09.2020, 12:06
	Hugo121, обычная история.... начинается с простого незначного вопроса и потом всё больше и больше..... 0

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	21.09.2020, 15:37
	Потому что мой короткий простой код делает именно то что Инга написала в вопросе, и ничего более. Но он только код, и без кнопки в файле... 0

@vedunasv Наивное Существо 666 / 141 / 27 Регистрация: 09.05.2020 Сообщений: 750 Записей в блоге: 15
	21.09.2020, 20:49
	Hugo121, да,да,да !!!! Я спорить не буду. Я не критикую )))) Я критикую тех, кто задаёт вопросы - кто хочет готовую кнопку прямо в файле данных по щучьему велению..... Вместо того, чтоб сразу выдать полное задание (и, конечно, дать свой вариант решения своей же задачки...). 0