Excel的VBA：複製表作爲一列

Question

我有一個Excel工作表，看起來像這樣

data1 data2 data3 ... data10 
... ... ... ... ... 
dataX dataY dataZ ... dataN 

我需要somhow「扁平化」數據到像這樣的單個列：

data1 
data2 
data3 
... 
data10 
dataX 
dataY 
dataZ 
... 
dataN 

我試着創建一個宏，可以從選擇開始自動執行復制+粘貼過程。這是我的代碼：

Sub copyIn1Col() 
' 
' copyIn1Col Macro 
' 
' Keyboard Shortcut: Ctrl+r 
' 
    Selection.copy 
    Range("B31").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 
    Range("D3:D13").Select 
End Sub 

問題在於它覆蓋複製的選擇到相同的範圍。

Answer 1

最簡單和最快的就是使用數組。我假設以下

1. 的數據是在Sheet1從範圍A1到E15
2. 你想在Sheet2中電池的輸出A1

希望這是你想要的嗎？

Option Explicit 

Sub Sample() 
    Dim inPutR, outPut() 
    Dim i As Long, j As Long, n As Long 

    '~~> Change this to the respective range 
    inPutR = ThisWorkbook.Sheets("Sheet1").Range("A1:E15") 

    ReDim Preserve outPut(UBound(inPutR, 1) * UBound(inPutR, 2)) 

    For i = LBound(inPutR, 1) To UBound(inPutR, 1) 
     For j = LBound(inPutR, 2) To UBound(inPutR, 2) 
      outPut(n) = inPutR(i, j) 
      n = n + 1 
     Next j 
    Next i 

    ThisWorkbook.Sheets("Sheet2").Range("A1").Resize(UBound(outPut) + 1) = _ 
    Application.Transpose(outPut) 
End Sub 

Answer 2

這是我修改後用來做你要找的東西的一個子。它將內容轉儲到名爲「Data」的工作表中，將其更改爲您希望將其添加到的任何工作表。

Sub Transform() 

Dim rows As Long 
Dim cols As Long 
Dim r As Long 
Dim c As Long 
Dim t As Long 

t = 1 
rows = ActiveSheet.UsedRange.rows.Count 
cols = ActiveSheet.UsedRange.Columns.Count 

Application.ScreenUpdating = False 

For r = 1 To rows 'If you have headers change 1 to the first row number of data 
    For c = 1 To cols 

     Sheets("Data").Cells(t, 1) = ActiveSheet.Cells(r, c).Value 

     t = t + 1 
    Next c 
Next r 


Application.ScreenUpdating = True 

End Sub