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

Question

我拥有的数据是这样的

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，则代码只会正确运行。如何使光标/选择自动转到第一个单元格，以便即使用户选择了其他单元格，代码也能正常工作。

Answer 1

试试下面的代码:

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开始