excelmacros用于在一列下粘贴多列数据

在excel中的数据是以下格式的，

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

有人可以帮我创build它的macros。

我使用下面的macros，但它不工作，

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)) 

然后拖/填满两列，并向下两行。

这个公式使用整个第二行作为数据的引用，所以无论它将包含多less列，只需要拖拽/填充足够数量的行。

如果数据模式与每三列不同，则将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的解决scheme（以防万一你select不去与斯科特的优秀公式）将是：

 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 

注意：代码假定用户在select数据范围时不包括标题。