Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Вертикальное транспонирование исходной таблицы на другой лист, Дана горизонтальная таблица необходимо перевести в вертикальную
 
#1
15.04.2018 13:00:34
Дана горизонтальная таблица необходимо перевести в вертикальную так чтобы каждый следующий столбец горизонтальной таблицы находился в вертикальной под предыдущим столбцом. А так же возможно ли такое преобразование в обратном порядке?
 
 
 
#2
15.04.2018 13:02:10
Название темы должно отражать суть задачи. Предложите новое. Модераторы заменят.
 
 
 
#3
15.04.2018 13:07:52
Цитата
vikttur написал:
Название темы должно отражать суть задачи. Предложите новое. Модераторы заменят
Замените пожалуйста у меня не хватает мыслетоплива как ее заменить и какова суть. Спасибо!
 
 
 
#4
15.04.2018 13:08:58
закрою, если Вы сами не в состоянии сформулировать свою мысль.
Как другие поймут, что Вам надо?
 
 
 
#5
16.04.2018 05:41:01
Название темы: Вертикальное транспонирование исходной таблицы на другой лист.

Макрос:
Код
Sub VertTranspose()
Dim aa As Range, bb As Range, a&, b%
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set aa = Sheets(1).[a2].CurrentRegion: a = 2
For b = 2 To aa.Columns.Count
  Set bb = Intersect(aa, Rows("2:" & aa.Rows.Count), Columns(b))
  Set bb = Union(Intersect(aa, Rows("2:" & aa.Rows.Count), Columns(1)), bb)
  With Sheets(3)
    bb.Copy .Range("B" & a)
    Sheets(1).Rows(1).Columns(b).Copy .Range("A" & a & ":A" & a + aa.Rows.Count - 2)
  End With
  a = a + aa.Rows.Count - 1
Next
Sheets(3).Columns("A:C").AutoFit
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
 
 
 
#6
16.04.2018 09:03:01
Anchoret, Спасибо добрый человек, если понадобиться проверить правильность выставления цен/тарифов на электроэнергию обращайся с радостью тебе помогу
 
 
 
#7
16.04.2018 16:49:34
Вариант с формулами
1 столбец
Код
=IFERROR(INDEX(данные!$B$1:$AF$1;;CEILING(ROWS($2:2)/COUNTA(данные!$A$2:$A$25);1));"")
2 столбец
Код
=INDEX(данные!$A$2:$A$25;MOD(ROWS($1:1)-1;COUNTA(данные!$A$2:$A$25))+1)
3 столбец
Код
=INDEX(данные!$B$2:$AF$25;MOD(ROWS($2:2)-1;COUNTA(данные!$A$2:$A$25))+1;MATCH(A2;данные!$B$1:$AF$1;0))
 
 
 
#8
16.04.2018 21:54:47
Вариант на массивах
Код
Sub test()
    Dim arr(), i&, j&, x&
    arr = Лист1.UsedRange.Value
    i = UBound(arr) * UBound(arr, 2)
    ReDim iarr(1 To i, 1 To 3)
    For i = 2 To UBound(arr, 2)
        For j = 2 To UBound(arr)
            x = x + 1
            iarr(x, 1) = arr(1, i)
            iarr(x, 2) = arr(j, 1)
            iarr(x, 3) = arr(j, i)
    Next j, i
    Worksheets.Add
    ActiveSheet.[a2].Resize(UBound(iarr), 3) = iarr
End Sub
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#9
17.04.2018 00:39:26
OFF:
Я бы заменил часть фразы:
Цитата
Nordheim написал:
, а все простое гениально!!!"
на ", но не все простое гениально." :)

П.С.: Разумется речь не о Вас и не о Вашем решении)
 
 
 
Страницы: 1
Наверх