Выберите каждую N-ю строку и переместитесь в столбцы - PullRequest
Новая
       9

Выберите каждую N-ю строку и переместитесь в столбцы

0 голосов
/ 20 января 2012

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

Таким образом, в настоящее время у меня есть набор данных Excel с 10 000 записей в следующем примере: 

Name
Street
City, State Zip
Name
Street
City, State Zip
etc

Мое желание - иметь возможность переместить все строки с street в их собственный столбец и переместить city, state zip в свой собственный столбец.

Таким образом, электронная таблица выглядит так: 

Name     Street    City, State    Zip
Name     Street    City, State    Zip
Name     Street    City, State    Zip

1 Ответ

3 голосов
/ 21 января 2012

Вот простое Sub для изменения ваших данных с комментариями сома для объяснения каждого шага.

В нем нет проверки целостности данных или обработки ошибок, вы должны добавить это для создания надежного решения 

Sub ReshapeData()
    Dim rng As Range
    Dim Src As Variant, Dst As Variant
    Dim i As Long

    ' Get Data From Sheet
    ' Assumes data starts at A1 on active sheet and has no gaps
    Set rng = Range([A1], [A1].End(xlDown))
    ' Copy data to a variant array
    Src = rng
    ' Set size of another array to match result
    ReDim Dst(1 To UBound(Src) / 3, 1 To 3)
    '  Loop through source array, copy data to desination array
    For i = 0 To UBound(Dst) - 1
        Dst(i + 1, 1) = Src(i * 3 + 1, 1)
        Dst(i + 1, 2) = Src(i * 3 + 2, 1)
        Dst(i + 1, 3) = Src(i * 3 + 3, 1)
    Next
    ' Delete original data
    rng.ClearContents
    ' Put new data on sheet
    rng.Resize(UBound(Dst), 3) = Dst
End Sub
...