セルのデ－タ（表デ－タ）を1列に並べる方法

質問

EXcelの使い方が良くわからないので教えてください。
下記（1）を（2）に並べ替える方法を教えてください。
（1）10個のセルに入ったデ-タ
a b c d e
f g h i j

（2）1列デ-タに並べ替える
a
b
c
・
・
・
よろしくお願いいたします。

回答No.3

KenKen_SP · ベストアンサー

こんにちは。KenKen_SP です。

たまにありますね。こういう並べ替えの作業(^^)
VBA でやってみます。

【手順】
1.　[Alt]+[F11]キー押下で、Visual Basic Editor（以下 VBE）が起動
2.　[挿入]-[標準モジュール]クリック
4.　開いたスペースに、下記コードを コピー＆ペースト
5.　VBE を閉じる
6.　ワークシートでセルを範囲選択
7.　[Alt]+[F8]キー押下でマクロ実行

'-------ここから--------------------------------------------------------

Sub Sample()

　　Dim Buf As Variant
　　Dim Ret() As Variant

　　'選択されているのがセル以外なら中止、セルが1つでも中止
　　If TypeName(Selection) <> "Range" Or Selection.Count = 1 Then Exit Sub
　　'総件数が65536を超えたら警告
　　If Selection.Count > 65536 Then
　　　　If MsgBox("データ数が65,536件を超えています." & vbCrLf & _
　　　　　　　　　"超えた分は無視されます.", vbOKCancel) = vbCancel Then
　　　　　　Exit Sub
　　　　End If
　　End If

　　'配列のサイズを決める
　　ReDim Ret(1 To Selection.Count, 1 To 1)
　　'選択範囲をバッファ
　　Buf = Selection.Value
　　'要素を並べ替え
　　Cnt = 1
　　For i = 1 To UBound(Buf) '行方向
　　　　For j = 1 To UBound(Buf, 2) '列方向
　　　　　　Debug.Print TypeName(Buf(i, j))
　　　　　　Ret(Cnt, 1) = Buf(i, j)
　　　　　　Cnt = Cnt + 1
　　　　Next j
　　Next i

　　'新規シートに書き出し
　　With Worksheets.Add
　　　　.Range("A1").Resize(UBound(Ret)).Value = Ret
　　End With

　　'終了メッセージ表示
　　MsgBox "終了しました", vbInformation

End Sub

'---------------------------------------------------------ここまで------

お礼

KenKen_SP様
本当にありがとうございました。もう使っておりまして、とても快適です。

回答No.9

Wendy02

KenKen_SPさん、こんばんは。

今回は、しなかったけれども、
＞　If UBound(Ret) > 65536 Then　Cnt = 65536　'<--- 追加

作成中、本来は、列を増やしていくのがいいかもしれないと思いました。セルの数は、１シートで、2^24 個ありますからね。ただ、手間を考えてやめてしまいました。

また、一種の縦横変換と考えたほうがよいかもしれませんね。つまり、縦横規定のマトリックスの中に入れることも、ある程度、考慮しないといけないようにも思いました。（これは、単なる思い付きですが。）

回答No.8

KenKen_SP

#3 です。

ご質問主 amine さんへ

65536行を超える場合の例外処理がもれてました。次のような例外処理を書き
足して下さい。あと、変数Cntの宣言なんかも漏れてます。適当ですみません。

　'新規シートに書き出し
　If UBound(Ret) > 65536 Then　Cnt = 65536　'<--- 追加
　With Worksheets.Add
　　　.Range("A1").Resize(Cnt).Value = Ret　'<--- Resizeの括弧内を変更
　End With

Wendy02 さんへ

Wendy02 さんのコードを見て、上記のことに気がつきました。中途半端なこと
ばかりしている自分を反省しました。いつも勉強させてもらってます。

imogasi さんへ

なるほど。For Each を使うと最初に列方向へセルのフォーカスが移動してい
くのでしたね。参考になりました。

回答No.7

imogasi

VBAなら簡単に短く
Sub test01()
Dim cl As Range
Dim sh2 As Worksheet
Set sh2 = Worksheets("sheet2") 'もって行く先シート名
j = 1 '開始行
For Each cl In Selection
If cl = "" Then
Else
sh2.Cells(j, "A") = cl 'A列にセット
j = j + 1
End If
Next
End Sub
でできます。
今のデータがあるシートのデータ部分を範囲指定してから（余分目の
四角範囲）実行のこと。

お礼

ありがとうございました。ＶＢＡっていろいろなことができるのですね。勉強になります。

回答No.6

Wendy02

KenKen_SPさんと同じ２次元配列でも、配列の入れ方を簡単にさせました。こういうものは、後だしでも構わないでしょうね。それぞれは、単なる個人のテクニックですから。ちなみに、KenKen_SPさんのものよりも、Rangeオブジェクトから配列に入れていますので、スピードはかなり落ちます。

'<標準モジュール>
Option Explicit
Sub Sample2()
　 Dim myArray() As Variant
　Dim i As Long, num As Long
　'データのある場所にマウスカーソルを置く
　With ActiveCell.CurrentRegion
　　If .Count = 1 Then
　　　MsgBox "データのある場所にマウスカーソルを置いてください。", 16
　　　Exit Sub
　　　Else
　　　'655356以下の数を添え字とする
　　　num = Application.Min(Rows.Count, .Count)
　　　ReDim myArray(1 To num, 1 To 1)
　　　For i = 1 To num
　　　　myArray(i, 1) = .Cells(i).Value
　　　Next i
　　End If
　End With
　'シートを増やす
　With Worksheets.Add(After:=Worksheets(Worksheets.Count))
　'シートを増やしたくないようでしたら、With Worksheets("Sheet3")などとする
　　.Range("A1").Resize(num).Value = myArray()
　End With
　Beep
End Sub

お礼

ありがとうございました。とても勉強になります。

回答No.5

fukkyse

A1にa～E2にjが入力されているとして、

F1に

=OFFSET($A$1,INT((ROW(A1)-1)/5),MOD(ROW(A1)-1,5),1,1)

として、下方向にコピー。

関数の意味については、helpなどで調べてみてください。

お礼

ありがとうございました。勉強になりました。

回答No.4

KenKen_SP

#3 です。

#3のコードで

Debug.Print TypeName(Buf(i, j))

は不要ですから、この行を削除して下さい。
実行スピードが落ちますので。

回答No.2

kaguura

1列ずつコピー＆ペーストする方法なら。

1)a～eをドラッグして右クリック、コピー
2)空いてるセルを右クリック、'形式を選択して貼り付け'を選択
3)'行列を入れ替える'をチェックしてOK
4)f～jについて、1)～3)を繰り返す

回答No.1

mu2011

以下の方法で如何でしょうか。

・データａ～ｅを選択コピーし、コピー先で右クリック→形式を選択して貼り付け→行列を入れ替えをチェック→ＯＫ
・データｆ～ｊも同様

補足

早速のご回答ありがとうございます。ずうずうしいとは思いますが追加で教えてください。
　これぐらいのデ-タならよいのですが、もっと行、列が多いときに、（1）のデ－タすべてを一括選択して（2）のように1列に並べ替えるような、都合の良い方法はありませんでしょうか？
　よろしくお願いいたします。