使用Excel VBA将所有列移动到单行

我拥有的数据就是这样

23 | 34 | 56 | 75 | 23 56 | 34 | 56 | 23 | 12 12 | 34 | 56 | 78 | 12 

我想将其转换为单列中的所有内容

 23 34 56 75 23 56 34 56 23 12 12 34 56 78 12 

我目前使用的代码如下，

 Sub ReArrangeCols() ActiveCell.Offset(0, 1).Range("A1").Select Range(Selection, Selection.End(xlDown)).Select Selection.Cut Selection.End(xlToLeft).Select Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Range("A1").Select ActiveSheet.Paste Selection.End(xlUp).Select Selection.End(xlToRight).Select Range(Selection, Selection.End(xlDown)).Select Selection.Cut Selection.End(xlToLeft).Select Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Range("A1").Select ActiveSheet.Paste Selection.End(xlUp).Select Selection.End(xlToRight).Select Range(Selection, Selection.End(xlDown)).Select Selection.Cut Selection.End(xlToLeft).Select Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Range("A1").Select ActiveSheet.Paste Selection.End(xlUp).Select Selection.End(xlToRight).Select Range(Selection, Selection.End(xlDown)).Select Selection.Cut Selection.End(xlToLeft).Select Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Range("A1").Select ActiveSheet.Paste Selection.End(xlUp).Select End Sub 

• Q1 – 运行时间：3-4秒。 如何优化？

• Q2 – 如果所选单元格是第一个单元格，那么代码只能正确运行，即上例中的23。 我如何使光标/select自动到第一个单元格，以便代码将工作，即使用户select了一些其他单元格。

Answer 1

尝试这个：

 Private Sub Test() Dim src As Range Dim out() As String Dim I As Integer, counter As Integer Set src = Cells(1, 1).CurrentRegion counter = src.Cells.Count ReDim out(1 To counter) For I = 1 To src.Cells.Count out(I) = src.Cells(I).Value Next src.ClearContents Cells(1, 1).Resize(counter, 1).Value = Application.WorksheetFunction.Transpose(out) End Sub 

Answer 2

试试下面的代码：

 Sub RangetoColumn() Dim LastRow As Long, LastColumn As Long Dim CurrentSheet As Worksheet, TargetSheet As Worksheet Dim i As Long, j As Long, Count As Long Set CurrentSheet = ThisWorkbook.Worksheets("Sheet1") Set TargetSheet = ThisWorkbook.Worksheets("Sheet2") LastRow = CurrentSheet.Cells(Rows.Count, "A").End(xlUp).Row Count = 1 For i = 1 To LastRow LastColumn = CurrentSheet.Cells(i, Columns.Count).End(xlToLeft).Column For j = 1 To LastColumn TargetSheet.Range("A" & Count).Value = CurrentSheet.Cells(i, j).Value Count = Count + 1 Next j Next i End Sub 

假设 ：
1.数据在Sheet1 ，结果将粘贴在Sheet2 。
2.数据从Cell A1开始