Транспонирование больших столбцов с разбивкой по листам

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Транспонирование больших столбцов с разбивкой по листам (Макросы/Sub)

40_b

Дата: Четверг, 03.08.2017, 17:52 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

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

Задача: есть 5 столбцов с большим количеством строк (более 5 000).
Для удобства отображения строки транспонируются, разбиваются по кусочкам на 20 ячеек на лист. Вторые 20 ячеек на второй лист и так далее. В итоге получаем, если взять 5000 строк, 250 листов.
Далее по некоторым параметрам объединяются значения и добавляются стили, у каждого параметр свой стиль.

В примере я постарался показать, что получается в итоге. На листе 1 кусок импровизированных данных, которые транспонированы по 20 ячеек на листы 2 и 3.

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

К сообщению приложен файл: 3385959.xls (24.5 Kb)

Ответить

Kuzmich

Дата: Четверг, 03.08.2017, 19:18 | Сообщение № 2

Группа: Проверенные

Ранг: Ветеран

Сообщений: 715

Репутация: 157 ±

Замечаний: 0% ±

Excel 2003

[vba]

Код

Sub Raznesti_20()
Dim i As Long
Dim iLastRow As Long
Dim n As Integer
iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
    n = 2
  For i = 2 To iLastRow Step 20
  With Worksheets("Лист" & n)
    Range("A1:D1").Copy
    .Range("A10").PasteSpecial Transpose:=True
    Range("A" & i & ":D" & i + 19).Copy
    .Range("B10").PasteSpecial Transpose:=True
  End With
   n = n + 1
  Next
End Sub

[/vba]