Question

在Excel中，数据采用以下格式，

但我需要以下格式的数据，

有人可以帮助我为它创建宏。

我使用了下面的宏，但它不起作用，

Sub CombineColumns1()
'updateby Extendoffice 20151030
        Dim xRng As Range
        Dim i, j As Integer
        Dim xLastRow As Integer
        Dim xTxt As String
        On Error Resume Next
        xTxt = Application.ActiveWindow.RangeSelection.Address
        Set xRng = Application.InputBox("please select the data range", "Kutools for Excel", xTxt, , , , , 8)
        If xRng Is Nothing Then Exit Sub
        xLastRow = xRng.Columns(1).Rows.Count + 1
        For i = 4 To xRng.Columns.Count
                For j = 1 To 3
                        Range(xRng.Cells(j, i), xRng.Cells(xRng.Columns(i).Rows.Count, i)).Cut
                        ActiveSheet.Paste Destination:=xRng.Cells(xLastRow, 1)
                        xLastRow = xLastRow + xRng.Columns(i).Rows.Count
                Next
                j = 1
        i = i + 2
        Next
End Sub

Answer 1

对于公式，我将原始数据放在第1行和第2行。然后在第4行中，我只放置了三个标题。

然后在A5我把这个公式：

=INDEX($2:$2,((ROW(1:1) - 1) * 3) + 1 + (COLUMN(A:A)-1))

然后拖动/填充两列，然后向下两行。

此公式使用整个第二行作为数据的参考，因此无论它包含多少列，只需要拖动/填充足够数量的行。

如果数据模式不同于每三列，则将3更改为模式中的列数。

根据您的意见：

=IFERROR(INDEX($2:$4,INT((ROW(1:1)-1)/(MATCH("ZZZ",$1:$1)/3))+1,(MOD((ROW(1:1)-1),MATCH("ZZZ",$1:$1)/3) *3)+1 + (COLUMN(A:A)-1)),"")

要先行，然后列翻转两行引用：

=INDEX($2:$4,MOD(ROW(1:1)-1,3)+1,INT((ROW(1:1)-1)/3)*3+1+COLUMN(A:A)-1)

Answer 2

VBA解决方案（以防万一你不选择斯科特优秀的公式）将是：

Sub CombineColumns1()
    Dim xRng As Range
    Dim i As Long, j As Integer
    Dim xNextRow As Long
    Dim xTxt As String
    On Error Resume Next
    With ActiveSheet
        xTxt = .RangeSelection.Address
        Set xRng = Application.InputBox("please select the data range", "Kutools for Excel", xTxt, , , , , 8)
        If xRng Is Nothing Then Exit Sub
        j = xRng.Columns(1).Column
        For i = 4 To xRng.Columns.Count Step 3
            'Need to recalculate the last row, as some of the final columns may not have data in all rows
            xNextRow = .Cells(.Rows.Count, j).End(xlUp).Row + 1

            .Range(xRng.Cells(1, i), xRng.Cells(xRng.Rows.Count, i + 2)).Copy .Cells(xNextRow, j)
            .Range(xRng.Cells(1, i), xRng.Cells(xRng.Rows.Count, i + 2)).Clear
        Next
    End With
End Sub

注意：代码假设用户不，包括选择数据范围时的标题。

用于在一列下粘贴多列数据的excel宏

2 个答案: