Question

我一直在寻找一种解决方案，用于将单列中的每5个单元格移动到Excel中的新相邻列。我知道https://www.extendoffice.com/documents/excel/3360-excel-transpose-every-5-rows.html，但是它并不能解决我想要的问题。

要指定我要实现的目标-可以说我有专栏：

Dim LastRow As Long
Dim LastColumn As Long
Sub InsertFileName()
  Application.ScreenUpdating = False
  Dim i As Long
  LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
  For i = 1 To LastRow
    LastColumn = ActiveSheet.Cells(i, ActiveSheet.Columns.Count).End(xlToLeft).Column
    ActiveSheet.Cells(i, LastColumn + 1) = "=CELL(""filename"")"
  Next i
  Application.ScreenUpdating = True
End Sub

在Excel工作表中。我不确定是否在所有使用此关键字数据的解决方案上将其称为“转置原因”设置了不同的内容。我需要的是：

当然，我正在处理的数据有更多行，并且需要以5为间隔跨到更多列。是否有任何简单的vba或公式可以实现？

Answer 1

这会将第一列块明智地转换为每行5行的列：

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

Answer 2

从本质上说：

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

放置在B2中，然后自动向下和向右填充（所有数据都在A列中）

Answer 3

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

Answer 4

..一种替代方法，因为我之前的代码影响了结果列下方的内容

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

每5个单元格移到新列

4 个答案: