Распределить макросом данные по листам в excel

Krevetka

если не очень сложная задача, помогите сделать
есть книга, на одном из листов - таблица 17*х (х~1000)
данные по первому столбцу отсортированы,
нужно раскидать таблицу в новую книгу по листам (по первому столбцу, те
столбец типа
яблоко
груша
зерно
нужно в книге листы яблоко груша и зерно, ну и соответствующие данные из оставшихся колонок
я так понимаю, нужно перебором двигаться по столбцу, как только новое слово - новый лист
но вот с VB проблема, поэтому прошу помощи

a7137928

Если операция разовая, то ее проще сделать вручную и не париться с макросом.
2. Если тебе таки нужен макрос, то вот он.
Предположения:
1) данные в первом столбце отсортированы. То есть, идет кусок для одного листа, потом кусок для другого листа, и так далее.
2) создавать листы будем в этой же книге. Данные в первом столбце не совпадают с названием ни одного существующего листа.
3) данные в первом столбце допустимы для создания соответствующих листов (некоторые символы в названиях листов использовать нельзя).
4) данные в первом столбце не являются числами. Иначе конструкция sheets(new_shname) не будет работать. Например, если new_shname="1", то sheets(new_shname) возьмет не лист с названием 1, а лист с номером 1.
Собственно, макрос:
Sub razbrosat_po_listam
ncols = 17 'number of rows
curpos = 1 ' number of row where the data for the new sheet begins
shname = "Лист1"
new_shname = ""
i = 0
nrows = 0
' Dim new_sheet As Variant
While Len(Sheets(shname).Cells(curpos, 1 > 0
' begin the new sheet
new_shname = Sheets(shname).Cells(curpos, 1).Value
i = curpos

While Sheets(shname).Cells(i, 1).Value = new_shname
i = i + 1
Wend 'after the cycle is finished we have i==number of where the new sheet begins
nrows = i - curpos 'number of rows to copy

ActiveWorkbook.Sheets.Add After:=Sheets(Sheets.Count) 'make new sheet, it will be the last one
Sheets(Sheets.Count).Name = new_shname 'change new sheet name, so now we can call it by new_shname

'Sheets(shname).Range(Cells(curpos, 1 Cells(curpos + ncols - 1, nrows.Copy 'copy data
Sheets(shname).Activate
ActiveSheet.Range(Cells(curpos, 1 Cells(curpos + nrows - 1, ncols.Copy
'Selection.Copy
Sheets(new_shname).Activate
ActiveSheet.Paste 'paste data

'and now we move curpos
curpos = i
Wend
End Sub

он чуток кривой (я не помню, как бороться с копи-пейст, поэтому переключаю activesheet для копирования но вроде работает.

tatako64

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

a7137928

Можно даже без пивота: фильтром выделять и ручками копировать. Если человек не знаком с пивотами, то так будет во многих случаях быстрее.

Krevetka

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

Krevetka

ругается на
While Len(Sheets(shname).Cells(curpos, 1 > 0

tatako64

У меня скрипт Данте отработал без ошибок с первого раза. Перед запуском заменил только количество колонок на 5 и shname на Sheet1.

Skilet3d

ругается на
While Len(Sheets(shname).Cells(curpos, 1 > 0
Там вначале скрипта имя листа возможно надо изменить, в указанном скрипте данные хранятся на листе1

Skilet3d

Sheets(shname).Activate
     ActiveSheet.Range(Cells(curpos, 1 Cells(curpos + nrows - 1, ncols.Copy
     'Selection.Copy
копирование можно просто заменить
Sheets(shname).Range(Cells(curpos, 1 Cells(curpos + nrows - 1, ncols.Copy
'Selection.Copy
а вставку так уже не заменишь. Да кстати вместо Activate лучше select использовать , он быстрее работает

a7137928

То есть, copy работает просто как sheet.range.copy, а вот пейст работает только как activesheet.paste, верно?
Вот я че-то такое помнил, но ломало разбираться, поэтому тупо сделал переключение актившита. И комменты от дебага не удалил
Почему селекшн быстрее? Потому что не переключает туда-сюда листы?

Skilet3d

То есть, copy работает просто как sheet.range.copy, а вот пейст работает только как activesheet.paste, верно?
Вот я че-то такое помнил, но ломало разбираться, поэтому тупо сделал переключение актившита. И комменты от дебага не удалил
Почему селекшн быстрее? Потому что не переключает туда-сюда листы?
1. Да.
2. Точно не помню, но Activate почему то обычно тормозит

Krevetka

спасибо, парни!
подогнал под свою таблицу, а вот как сделать, чтобы в новой книге создавалось?
workbooks.add
а потом как дать понять, что со старой надо копировать текст, а в новую вставлять?

tatako64

Пользуйся макрорекордером, а полученные куски кода уже подгоняй в свой скрипт.

Krevetka

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

a7137928

workbooks.add
а потом как дать понять, что со старой надо копировать текст, а в новую вставлять?
Заботай в инете тему "объектная модель в visual basic", и все сразу станет понятнее.
У тебя есть семейство workbooks. Когда ты делаешь workbooks.add, туда добавляется новый объект. Обратиться к нему ты можешь при помощи workbooks(wbk_name) или workbooks(wbk_no т.е. надо знать имя или номер. Например workbooks("Книга1") или workbooks(1). Тебе достаточно знать что-то одно, имя или номер.
Проблема в том, что после workbooks.add фиг знает, какое имя и какой номер будут у новой книги - номер зависит от того, сколько книг уже открыто на данный момент, а имя - какое последнее шаблонное имя было в данной рабочей сессии.
Выходов тут два:
1) писать умный макрос, который будет правильно работать. Например, в моем макросе я добавлял листы. Чтобы не было проблем с тем, какой номер/имя будет у добавленного листа, я принудительно ставил его в конец (After:=sheets(sheets.count) а потом обращался к нему как к последнему (sheets(sheets.count менял ему имя как надо и делал что хотел.
Есть много других трюков, как добраться до имени новой книги. Например, если мы знаем, что новая книга ставится в конец, или что она становится активной, можно это использовать.
2) пишем тупой макрос, который правильно работает в строго одной ситуации. Например, ты пишешь макрос, который будет работать только когда у тебя открыта одна книга. Тогда после add новая книга будет иметь номер 2 (по идее :) ). Если у тебя будет открыто две книги, макрос не сработает - ну и фиг с ним, для себя же пишем.
После того, как ты понял, как зовется новая книга, можно обращаться к ее листам, заводить новые workbooks(2).Sheets.Add, и так далее.

Krevetka

пасиб парни, оптимизировал теперь я свою работу!)
теперь вместо 2 часов трахания я за 30 мин делаю то, что нужно
сенкью!

svetik5623190

Ну так поставь по пивку оказавшим тебе помощь участникам треда.
Оставить комментарий
Имя или ник:
Комментарий: