Excel VBA Транспонировать динамический список с повторяющимся заголовком на новый лист

Мне нужно скопировать список данных с повторяющимся заголовком и перенести его на другой лист. VBA должен приспосабливаться к разным размерам и количеству списков.

Лист 1 выглядит так:

Фрукты
яблоко
груша
виноград
Фрукты
банан
апельсин
клубника

Лист 2 должен выглядеть так:

яблоко груша виноград
банан апельсин клубника


excel transpose vba
person kidron    schedule 09.12.2016    source источник
comment
Возможный дубликат транспонировать диапазон в VBA   -  person cyboashu    schedule 10.12.2016
comment
Так что вам нужно сделать это, круто. Что привело вас сюда? Вы пытались написать программу и застряли? Есть вопросы? Как мы можем помочь?   -  person vacip    schedule 10.12.2016

Ответы (1)


arrow_upward
1
arrow_downward

Предполагая, что нет пустых строк и что ваш список находится в столбце A, а Worksheet1 активен при запуске макроса

Sub flip_it()
Dim RowCount As Long
Dim SrcRng As Range
Rows(1).Insert
RowCount = Range("A1048576").End(xlUp).Row
Range("B1:B" & RowCount).FormulaR1C1 = "=if(RC[-1]=""FRUIT"",row(),""x"")"
Range("B1:B" & RowCount).Value = Range("B1:B" & RowCount).Value
Range("B1:B" & RowCount).RemoveDuplicates 1, xlNo
Range("C1").FormulaR1C1 = "=Counta(C2)"

    For x = 2 To Range("C1").Value
        row1 = Range("B" & x).Value + 1
            If x = Range("c1").Value Then
                row2 = RowCount
            Else
                row2 = Range("B" & x + 1).Value - 1
            End If
        Set SrcRng = Range(Cells(row1, 1), Cells(row2, 1))
        SrcRng.Copy

        With Worksheets("Sheet2")
            .Range("A" & x - 1).PasteSpecial xlPasteAll, xlPasteSpecialOperationNone, skipblanks, Transpose:=True
        End With

    Next x

Worksheets("Sheet2").Activate

End Sub
person Bad_Mama_Jama    schedule 10.12.2016
comment
Это прекрасно работает! Как я могу внести одно незначительное изменение?: Заголовок «Фрукты» находится в столбце A, но данные, которые нужно скопировать и переместить, находятся в столбце B. - person kidron; 12.12.2016