Question

我拥有的数据是这样的

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

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

开始

Answer 2

试试这个：

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

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

2 个答案: