Вставка с транспонированием

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

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

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вставка с транспонированием (Макросы/Sub)

cj081

Дата: Пятница, 01.08.2014, 17:11 | Сообщение № 1

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

Ранг: Новичок

Сообщений: 15

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

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

Excel 2010

Добрый день!
У меня постоянная рутинная работа в Excel

-
задача: копирование диапазона, вставка с транспонированием, удаление этого диапазона, следущая строчка - опять тоже самое.
Я написал макрос - но он жестко привязывается к ячейке.
Помогите, как сделать, чтобы он работал до конца листа.

Алгоритм.
Данные начинаются с А1-А4, содержатся в строках, следущие соответственно в А5-А8 и т.д. Мне нужно что бы они стали в столбцах - А1 остается на месте, А2-А4 - перенести в столбцы.

1. Встаем на ячейке А2,
2. Выделяем диапазон А2:A4 и копируем,
3. Встаем на столбце B2,
4. Специальная вставка значение с транспонированием,
5. Удаляем строки с выделенным диапазоном А2:A4.
Повтор для следущей строчки.

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

К сообщению приложен файл: 1610756.xlsm (12.3 Kb)

Сообщение отредактировал cj081 - Суббота, 02.08.2014, 10:16

Ответить

wild_pig

Дата: Суббота, 02.08.2014, 00:30 | Сообщение № 2

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

Ранг: Обитатель

Сообщений: 517

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

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

2003, 2013

[vba]

Код

Sub uuu()
     Dim rw&
     Application.ScreenUpdating = False
     For rw = 2 To Cells(Rows.Count, 1).End(xlUp).Row Step 4
          Cells(rw, 2) = Cells(rw, 1)
          Cells(rw, 3) = Cells(rw + 1, 1)
          Cells(rw, 4) = Cells(rw + 2, 1)
          Range(Cells(rw, 1), Cells(rw + 2, 1)).ClearContents
     Next
     Application.ScreenUpdating = True
End Sub

[/vba]

Ответить

cj081

Дата: Суббота, 02.08.2014, 10:07 | Сообщение № 3

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

Ранг: Новичок

Сообщений: 15

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

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

Excel 2010

Спасибо, wild_pig, но получилось вот что:

почему то формирование данных идет на строчку ниже, в итоге таблицы с 4мя столбцами не получается, + как бы удалить пустые строки.

К сообщению приложен файл: 9862738.jpg (14.4 Kb)

Сообщение отредактировал cj081 - Суббота, 02.08.2014, 10:08

Ответить

wild_pig

Дата: Суббота, 02.08.2014, 12:46 | Сообщение № 4

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

Ранг: Обитатель

Сообщений: 517

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

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

2003, 2013

Цитата cj081, 01.08.2014 в 17:11, в сообщении № 1

1. Встаем на ячейке А2,
2. Выделяем диапазон А2:A4 и копируем,
3. Встаем на столбце B2,
4. Специальная вставка значение с транспонированием,

Как просили так и сделал.
Поправил под новые задачи.
[vba]

Код

Sub uuu()
     Dim i&, ii&, j%
     Dim a(), b()
     With Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
         a = .Value
         ReDim b(1 To Round(UBound(a) / 4 + 0.5), 1 To 4)
         For ii = 1 To UBound(b)
             For j = 1 To 4
                 i = i + 1
                 If i > UBound(a) Then Exit For
                 b(ii, j) = a(i, 1)
             Next
         Next
         .ClearContents
     End With
     Cells(1, 1).Resize(UBound(b), UBound(b, 2)) = b
     Beep
End Sub

[/vba]

Ответить

cj081

Дата: Суббота, 02.08.2014, 13:02 | Сообщение № 5

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

Ранг: Новичок

Сообщений: 15

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

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

Excel 2010

wild_pig, спасибо огромное)))я в алгоритме косякнул)))

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вставка с транспонированием (Макросы/Sub)

Страница 1 из 1
1