1

私はこのようなExcelシートを持っています

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

次のように、データを1つの列に「フラット化」する必要があります。

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

それに関する問題は、コピーされた選択を同じ範囲に上書きすることです。

4

2 に答える 2

4

最も単純で最速の方法は、配列を使用することです。私は次のことを想定しています

  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
于 2012-12-22T05:28:13.750 に答える
2

これが私があなたが探していることをするために私が修正したサブです。「データ」と呼ばれるシートに内容をダンプし、追加したいシートに変更します。

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
于 2012-12-22T01:36:36.363 に答える