Страницы: 1
RSS
Перенос и расположение постоянного (одинакового) количество столбцов из горизонтальной таблицы в вертикальную
 
Уважаемые форумчане, здравствуйте!
Помогите решить проблему. Своими силами не получается (пробовал транспонирование и отмену свертывания столбцов, но либо они для такого не предназначены, либо я не правильно их использую). Подозреваю, что наверное ее проще решить или VBA или PQ (хотя тут на форуме есть такие Мастера, которые и формулами наверное такое смогут решить).
Задача в следующем:
у меня есть горизонтальная таблица,

где первые два столбца уникальные,

а далее по 5 (всегда по 5) столбцов повторяются n количество раз, с разными данными на пересечениях

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

Файл-пример как есть и как надо, прилагаю
PE Из горизонта в вертикаль.xlsx (16.02 КБ)
Заранее, спасибо за помощь!
Кто ясно мыслит, тот ясно излагает.
 
Код
A14    =ИНДЕКС(Таблица1[№ Вагона];ОСТАТ(СТРОКА()-СТРОКА(Таблица2[[#Заголовки];[№ Вагона]])-1;ЧСТРОК(Таблица1[№ Вагона]))+1)
C14    =ИНДЕКС(СМЕЩ(Таблица1[Количество];0;5*ЦЕЛОЕ((СТРОКА()-СТРОКА(Таблица2[[#Заголовки];[№ Вагона]])-1)/(ЧСТРОК(Таблица1[№ Вагона]))));ОСТАТ(СТРОКА()-СТРОКА(Таблица2[[#Заголовки];[Количество]])-1;ЧСТРОК(Таблица1[Количество]))+1)
И протянуть вправо и вниз.
 
pq
Пришелец-прораб.
 
МатросНаЗебре, AlienSx, спасибо огромное!
Кто ясно мыслит, тот ясно излагает.
 
Вариант VBA.
Код
Sub HorizToVert()
    HtoV ActiveSheet.ListObjects(1).DataBodyRange, ActiveSheet.ListObjects(2).DataBodyRange
End Sub

Private Sub HtoV(inputRange As Range, outputRange As Range)
    Const FIRST_COL = 2
    Const iSTEP = 5
    
    Dim arr As Variant
    arr = inputRange.Value
    
    Dim nn As Long
    Dim xa As Long
    For xa = FIRST_COL + 1 To FIRST_COL + ((UBound(arr, 2) - FIRST_COL) \ iSTEP) * iSTEP Step iSTEP
        nn = nn + 1
    Next
    
    Dim brr As Variant
    ReDim brr(1 To nn * UBound(arr, 1), 1 To FIRST_COL + iSTEP)
    
    Dim ya As Long
    Dim yb As Long
    Dim xb As Long
    For xa = FIRST_COL + 1 To FIRST_COL + ((UBound(arr, 2) - FIRST_COL) \ iSTEP) * iSTEP Step iSTEP
        For ya = 1 To UBound(arr, 1)
            yb = yb + 1
            For xb = 1 To FIRST_COL
                brr(yb, xb) = arr(ya, xb)
            Next
            For xb = 0 To UBound(brr, 2) - FIRST_COL - 1
                brr(yb, FIRST_COL + 1 + xb) = arr(ya, xa + xb)
            Next
        Next
    Next
    
    outputRange.Resize(UBound(brr, 1), UBound(brr, 2)).Value = brr
End Sub
Страницы: 1
Наверх