Перемещение каждых 5 ячеек в новый столбец - PullRequest
0 голосов
/ 21 февраля 2019

Я пытался найти решение для перемещения каждых 5 ячеек в одном столбце в новый соседний столбец в Excel.Мне известно о https://www.extendoffice.com/documents/excel/3360-excel-transpose-every-5-rows.html, но это не решает мою проблему так, как мне бы хотелось.

Чтобы указать, чего я хочу достичь - допустим, у меня есть столбец:

1
2
3
4
5
6
7
8
9
10

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

1,6
2,7
3,8
4,9
5,10

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

Ответы [ 4 ]

0 голосов
/ 21 февраля 2019

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

Sub ColumnToColumns_SetRows()
    Dim rng As Range, rws As Long, c As Long, prts As Long, i As Long

    rws = 5                                         'Number of rows to use in each column
    Set rng = Range("A1").Resize(rws)               'Starting range
    c = rng.Column                                  'Column of starting range
    prts = Cells(Rows.Count, c).End(xlUp) / rws + 1 'Division in parts

    For i = 1 To prts
        rng.Offset(, i).Value = rng.Offset(rws * i).Value
    Next i

    Range(Cells(rws + 1, c), Cells(Rows.Count, c).End(xlUp)).ClearContents

End Sub
0 голосов
/ 21 февраля 2019

Это преобразует первый блок столбцов в столбцы по 5 строк в каждом:

enter image description here

Option Explicit

Public Sub Transform()
    With ThisWorkbook.Worksheets("Sheet1")
        Dim LastRow As Long
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        Dim iRow As Long
        For iRow = 6 To LastRow Step 5
            .Range("A1").Offset(ColumnOffset:=(iRow - 1) / 5).Resize(RowSize:=5).Value = .Range(.Cells(iRow, "A"), .Cells(iRow + 5, "A")).Value
        Next iRow

        'clear copied values
        .Range("A6", "A" & LastRow).Clear
    End With
End Sub

enter image description here

0 голосов
/ 21 февраля 2019
Sub ColumnToColumnsSetRows()

    Dim rng As Range, r As Long, c As Long, rws As Long, ncl As Long

    Set rng = Range("A1")   'Starting range
    r = rng.Row             'Row of starting range
    c = rng.Column          'Column of starting range

    rws = 5                 'Number of rows to use in each column
    ncl = 1                 'Number of steps to move sideways


    Do Until IsEmpty(Cells(r, c).Offset(rws))
        Range(Cells(r, c).Offset(rws), Cells(Rows.Count, c).End(xlUp)).Cut Cells(r, c).Offset(, ncl)
        c = c + ncl
    Loop

End Sub
0 голосов
/ 21 февраля 2019

Итак, по сути:

=INDEX($A:$A;ROW(A1)+COLUMN(A1)*5-5)

помещается в B2 и автоматически заполняется вниз и вправо делает трюк (все данные в столбце A)

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...