преобразовать таблицу в "плоскую"

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

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

Мир MS Excel » Вопросы и решения » Вопросы по VBA » преобразовать таблицу в "плоскую"

qpp

Дата: Вторник, 09.04.2013, 10:14 | Сообщение № 1

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

Ранг: Форумчанин

Сообщений: 117

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

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

Коллеги, пожалуйста, помогите с макросом.

Нужно из исходной таблицы, в которой данные за периоды размещены в одну строку, привести ее к формату когда данные по датам идут в столбец.

У меня есть одно решение, которое преобразует таблицу в плоскую, но дело в том, что мое наименование это 8 столбцов (A-H), а данные следующие 8 столбцов , и такой цикл на несколько лет.

Файл прилагаю

вот такой код есть

[vba]

Код

Dim i&, j&, x&
With Sheets("1")
For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
     For j = 2 To .Cells(1, Columns.Count).End(xlToLeft).Column
         x = Sheets("2").Cells(Rows.Count, 1).End(xlUp).Row + 1
         Sheets("2").Cells(x, 1).Value = .Cells(i, 1).Value
         Sheets("2").Cells(x, 2).Value = .Cells(1, j).Value
         Sheets("2").Cells(x, 3).Value = .Cells(i, j).Value
     Next
Next
End With
End Sub

[/vba]

К сообщению приложен файл: 1809724.xlsx (17.6 Kb)

bigqpp
скайп

Ответить

qpp

Дата: Вторник, 09.04.2013, 18:27 | Сообщение № 2

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

Ранг: Форумчанин

Сообщений: 117

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

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

подсобите советом, пожалуйста

bigqpp
скайп

Ответить

LightZ

Дата: Вторник, 09.04.2013, 21:17 | Сообщение № 3

Группа: Авторы

Ранг: Форумчанин

Сообщений: 120

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

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

А где же данные? Или нужно просто даты скопировать в столбец?

E-mail: overseerpower@gmail.com
Skype: Bogdan_Rud
WMR: R166238237296

Ответить

qpp

Дата: Понедельник, 15.04.2013, 09:58 | Сообщение № 4

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

Ранг: Форумчанин

Сообщений: 117

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

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

Цитата (LightZ)

А где же данные?

все данные в прикрепленном файле.

bigqpp
скайп

Ответить

qpp

Дата: Понедельник, 15.04.2013, 15:43 | Сообщение № 5

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

Ранг: Форумчанин

Сообщений: 117

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

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

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

В моем случае шаг 8 (первые столбцы ) и к ним поочередно добавлять 8 следующих столбцов .

Прошу помощи.

bigqpp
скайп

Ответить

M73568

Дата: Понедельник, 15.04.2013, 17:08 | Сообщение № 6

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

Ранг: Форумчанин

Сообщений: 197

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

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

2007-2013

Всё что могу сказать, - таблица в Вашем примере не "плоская". Как Вы приведёте её к нужному виду я сказать не могу

К сообщению приложен файл: _1809724.xlsx (37.2 Kb)

Ответить

RAN

Дата: Понедельник, 15.04.2013, 22:42 | Сообщение № 7

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

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

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

2010

Это пишется макрорекордером за 1 минуту и дорабатывается 10 минут.
[vba]

Код

Sub qqq()
      Dim lr&, lc&, lr1&, i&
      lr = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
      lc = Sheets(1).Cells(2, Columns.Count).End(xlToLeft).Column
      For i = 9 To lc Step 8
          lr1 = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1
          Sheets(1).Range("A3:H" & lr).Copy Sheets(2).Range("A" & lr1)
          Sheets(1).Range(Sheets(1).Cells(3, i), Sheets(1).Cells(lr, i + 7)).Copy Sheets(2).Range("I" & lr1)
          Sheets(1).Cells(1, i).Copy Sheets(2).Range("Q" & lr1).Resize(lr - 2)
      Next
End Sub

[/vba]

Быть или не быть, вот в чем загвоздка!

Ответить

qpp

Дата: Вторник, 16.04.2013, 17:54 | Сообщение № 8

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

Ранг: Форумчанин

Сообщений: 117

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

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

спасибо.помогло !

bigqpp
скайп

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » преобразовать таблицу в "плоскую"

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