エクセルで横並びの複数データを縦の一本のデータにしたい

質問

こんにちは。宜しくお願い致します。

　　　Ａ　　　Ｂ　　Ｃ
1　静岡　埼玉　
2　福島　東京　愛媛
3　青森　
4　長崎　徳島　愛媛
5　東京　千葉　
6　秋田　兵庫　大阪
.
.
.

例えばこういう形で好きな都道府県の上位3つの解答がそれぞれあったとします。（1個の人もいるし、2個の人もいます）

これを別のシート（同じシートの違う場所でも構いません）に縦並び1本で出したいときどうしたらいいでしょうか。

★こういう風にしたい★

静岡
福島
青森
長崎
東京
秋田
埼玉
東京
愛媛
徳島
愛媛
千葉
兵庫
大阪
.
.

※好きな県などが人によって重複していても構いません、また順不同でもいいです。（縦並びのデータに東京が20個あってもよいということ）

形式を選択して貼り付けで行列を入れ替えるではうまくいかないです。

宜しくお願い致します。

回答No.5

imogasi · ベストアンサー

ＶＢＡで、もっと簡単に。
下記をＶＢＥの標準モジュールにコピーし貼りつけ。
元データのあるシートで、データのある範囲を範囲指定して（空白セルが範囲内にあっても結構）、下記を実行。
Sub ichiretu()
Dim cl As Range
p = 1
For Each cl In Selection
If cl <> "" Then
Worksheets("sheet3").Cells(p, "A") = cl
p = p + 1
End If
Next
End Sub
Sheet3のＡ列に並びます。

お礼

おはようございます
ＶＢＡの基本的なものも全く触ったことがなかったのですが、コピペで簡単に出来ました！
今回は、こちらを採用させて頂き、今後使っていこうと思っております。
ありがとうございました！

回答No.4

maruru01

こんにちは。maruru01です。

どこでもいいので、

=IF(COUNTIF($A$1:$C$6,"*")>=ROW(A1),INDEX($A$1:$C$6,ROUND(MOD(SMALL(IF(LEN($A$1:$C$6),COLUMN($A$1:$C$6)+ROW($A$1:$C$6)/1000),ROW(A1)),1)*1000,),INT(SMALL(IF(LEN($A$1:$C$6),COLUMN($A$1:$C$6)+ROW($A$1:$C$6)/1000),ROW(A1)))),"")

と入力して、[Ctrl]＋[Shift]＋[Enter]で確定します。
（数式の両端に「{}」が付いて、配列数式になります。）
そうしたら、これを下の行へ適当にコピーします。
なお、データ範囲は適宜変更して下さい。
数式を別のシートに入力する場合は、当然データ範囲にシート名を付けて下さい。

お礼

ご回答ありがとうございました！

回答No.3

ja7awu

その作業が一時的なものであれば、手作業でもそれ程手間がかかりませんし、
いろいろな方法があります。既にレスもありますのでこの方法には触れません。

しかし、このような作業が、頻繁に発生するようであれば、マクロを使って処理
する方法が得策と思います。

下記マクロを実行すると範囲を聞いてきますので、一列に並べ替えたい範囲を
選択し、[ＯＫ]すると、このシートの右側に変換された新しいシートが出来ます。

シート名は、現シート名に"(変換)"を付加した名前です。
既にそのシート名が存在する場合は、現シートのすぐ右に移動し、内容（値）を
クリアした後に変換データが作成されます。

一応、コードの設定方法を書いておきます。
１．Alt + F11 で VBE(Visual Basic Editor)を開きます。
２．VBE のメニューから[挿入] -->[標準モジュール] を指定します。
３．モジュールウィンドウに下記コードをコピーして貼り付けます。
４．Alt + Q （または、右上隅の×）でウィンドウを閉じ、シートに戻ります。
５．メニューから[ツール]-->[マクロ]-->[セキュリティ]で「セキュリティレベル」を
　「中」にして[OK]します。
６．実行するときは、Alt ＋ F8 (メニューから[ツール]-->[マクロ]-->[マクロ])で
　「データを別シートに一列変換」を指定し、[実行]ボタンを押します。

　(頻繁に使うようでしたら、ショートカットキーに割り付けるといいかも・・・）

Sub データを別シートに一列変換()
Dim ShOrg As Worksheet
Dim ShNew As Worksheet
Dim Hani As Range
Dim Rng As Range
Dim Rw As Long
Dim N As Integer
Dim ShName As String
Set ShOrg = ActiveSheet
If InStr(ShOrg.Name, "(変換)") Then
　　MsgBox "変換対象のシートではありません。", vbCritical
　　Exit Sub
End If
ShName = ShOrg.Name & "(変換)"
On Error Resume Next
Set Hani = Application.InputBox(vbLf & " ※ 一列に変換する" & _
　　　　"データ範囲を指定して、［ＯＫ］を" & vbLf & _
　　　　"　押してください。" & vbLf & vbLf & "　右側に 【" & _
　　　　ShName & " 】変換シートを作成します。", Type:=8)
If Err.Number > 0 Then Exit Sub
For N = 1 To Worksheets.Count
　　If Worksheets(N).Name = ShName Then
　　　　Set ShNew = Worksheets(N)
　　　　ShNew.Cells.ClearContents
　　　　Worksheets(N).Move After:=ShOrg
　　　　Exit For
　　End If
Next N
If N > Worksheets.Count Then
　　Set ShNew = Sheets.Add(After:=ShOrg)
　　ShNew.Name = ShName
End If
ShOrg.Activate
For Each Rng In Hani
　　If Not Trim(Rng.Value) = "" Then
　　　　Rw = Rw + 1
　　　　ShNew.Cells(Rw, 1).Value = Rng.Value
　　End If
Next Rng
MsgBox " 『 " & ShNew.Name & " 』 のシートに変換データを" & _
　　　　"作成しました。", vbInformation
End Sub

お礼

おはようございます。
ＶＢＡの知識が全くなかったのですが、コピペで出来るようでした！
ありがとうございました！

回答No.2

oresama

要件が
1、A列のデータが最初に並ぶ
2、B列のデータが次に並ぶが同じ行のC列にデータがある場合、次の行のB列のデータより先にC列のデータが並ぶ
とします。

B列とC列の間に1列挿入
（県データはB列とD列になります）

C1に
=IF(ISBLANK(B1),"",COUNTA($B$1:B1))
E1に
=IF(ISBLANK(D1),"",COUNTA($B$1:B1,$D$1:D1))
C2に
=IF(ISBLANK(B2),"",MAX($C$1:C1,$E$1:E1)+1)
以下末尾までコピペ
E2に
=IF(ISBLANK(D2),"",MAX($C$1:C2,$E$1:E1)+1)
以下末尾までコピペ

A列の末尾の次の行に
B、C列を「値の貼り付け」
その下に
D、E列を「値の貼り付け」
で、
B列に貼り付けられた、
C、Eの数字が優先順位になるので、
そこで並べ替えをすれば、
ご希望に適うと思われます。

文字にすると判り辛いかもしれませんが、
『優先順位を関数で作って並べ替える』とご理解ください。

お礼

ご回答ありがとうございました。
関数を使って出来ますね！
ありがとうございました

回答No.1

papayuka

オートフィルタで、B列とC列をそれぞれ「空白以外」で抽出して、A列の最後にコピペするのではダメでしょうか？

お礼

おはようございます。
確かにその方法でもできますね！
参考になりましたありがとうございました。