Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/преобразовать таблицу в "плоскую" - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
преобразовать таблицу в "плоскую"
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
скайп
 
Ответить
СообщениеКоллеги, пожалуйста, помогите с макросом.

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

У меня есть одно решение, которое преобразует таблицу в плоскую, но дело в том, что мое наименование это 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]

Автор - qpp
Дата добавления - 09.04.2013 в 10:14
qpp Дата: Вторник, 09.04.2013, 18:27 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 117
Репутация: 11 ±
Замечаний: 0% ±

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


bigqpp
скайп
 
Ответить
Сообщениеподсобите советом, пожалуйста

Автор - qpp
Дата добавления - 09.04.2013 в 18:27
LightZ Дата: Вторник, 09.04.2013, 21:17 | Сообщение № 3
Группа: Авторы
Ранг: Форумчанин
Сообщений: 120
Репутация: 48 ±
Замечаний: 0% ±

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


E-mail: overseerpower@gmail.com
Skype: Bogdan_Rud
WMR: R166238237296
 
Ответить
СообщениеА где же данные? Или нужно просто даты скопировать в столбец?

Автор - LightZ
Дата добавления - 09.04.2013 в 21:17
qpp Дата: Понедельник, 15.04.2013, 09:58 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 117
Репутация: 11 ±
Замечаний: 0% ±

Цитата (LightZ)
А где же данные?


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


bigqpp
скайп
 
Ответить
Сообщение
Цитата (LightZ)
А где же данные?


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

Автор - qpp
Дата добавления - 15.04.2013 в 09:58
qpp Дата: Понедельник, 15.04.2013, 15:43 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 117
Репутация: 11 ±
Замечаний: 0% ±

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

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

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


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

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

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

Автор - qpp
Дата добавления - 15.04.2013 в 15:43
M73568 Дата: Понедельник, 15.04.2013, 17:08 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 197
Репутация: 46 ±
Замечаний: 0% ±

2007-2013
Всё что могу сказать, - таблица в Вашем примере не "плоская". Как Вы приведёте её к нужному виду я сказать не могу
К сообщению приложен файл: _1809724.xlsx (37.2 Kb)
 
Ответить
СообщениеВсё что могу сказать, - таблица в Вашем примере не "плоская". Как Вы приведёте её к нужному виду я сказать не могу

Автор - M73568
Дата добавления - 15.04.2013 в 17:08
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]


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеЭто пишется макрорекордером за 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]

Автор - RAN
Дата добавления - 15.04.2013 в 22:42
qpp Дата: Вторник, 16.04.2013, 17:54 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 117
Репутация: 11 ±
Замечаний: 0% ±

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


bigqpp
скайп
 
Ответить
Сообщениеспасибо.помогло !

Автор - qpp
Дата добавления - 16.04.2013 в 17:54
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!