多行和多列excel电子表格放入单列，保留列A作为关键

考虑一下表格：

abcd key1 value1 value2 value3 key2 value1a value3a 

我需要将其转换成

 Key1 Value1 Key1 Value2 Key1 Value3 Key2 Value1a Key2 key2 Value3a 

这个代码的作用是将所有的数据放到一个单独的列中，包括空格，但是我需要保留第一列作为关键字，而我是在Excel中使用VBA的新手。

  Sub MultiColsToA() Dim rCell As Range Dim lRows As Long Dim lCols As Long Dim lCol As Long Dim ws As Worksheet Dim wsNew As Worksheet lCols = Columns.Count lRows = Rows.Count Set wsNew = Sheets.Add() For Each ws In Worksheets With ws For Each rCell In .Range("B1", .Cells(1, lCols).End(xlToLeft)) .Range(rCell, .Cells(lRows, rCell.Column).End(xlUp)).Copy _ wsNew.Cells(lRows, 1).End(xlUp)(2, 1) Next rCell End With Next ws End Sub 

表格大约有55行，12到30列。 理想情况下，也需要以相同的方式转换20页左右，所以这样做的程序化方式将是理想的，可以帮助吗？

Answer 1

这里是一个基本的例子，你如何能得到这样的工作。 希望这将有助于作为一个概念，你可以调整以最好地适应你在找什么：

 Sub MultiColsToA() Dim rCell As Range Dim cCell As Range Dim iCounter As Integer Dim iInner As Integer Dim ws As Worksheet Dim wsNew As Worksheet ' Find the full range of the original sheet (assumes each row ' in column A will have a value) Set rCell = Range("A1:A" & Range("A1").End(xlDown).Row) Set wsNew = Sheets.Add() For Each ws In Worksheets ' Set our sentinel counter to track the row iCounter = 1 ' Iterate through each cell in the original sheet For Each cCell In rCell ' This will likely need to be adjusted for you, but ' here we set a counter = 1 to the number of columns ' the original sheet contains (here 3, but can be changed) For iInner = 1 To 3 With wsNew ' Set the first column = the key and the second the ' proper value from the first sheet .Cells(iCounter, 1).Value = cCell.Value .Cells(iCounter, 2).Value = cCell.Offset(0, iInner).Value End With ' Increment the sentinel counter iCounter = iCounter + 1 Next iInner Next cCell Next ws End Sub