Excelで列に入っているデータを行に展開する方法

質問

添付画像のように、Excelシート上のA列に、店名、住所、電話番号が全て入っている状態を、A列に商店、B列に住所、C列に電話番号というように振り分けたいです。

シート上のデータは、既に振り分けてあるものと振り分けていないものが混在しています。
振り分けていないものは、店名と電話番号だけ、店名と住所と電話番号といったパターンがあります（他に、店名とメールアドレスだけの様なパターンも）。

店名+電話番号、店名+住所+電話番号　のパターンはある程度かたまっているため、Sheet上で範囲を手動で選択して、行への展開を実行したいと思っています。

関数かVBAで効率よく実行する方法を教えてください。

Excel2010です。

回答No.1

MackyNo1 · ベストアンサー

3行1セットの場合
例えばA10セルから3行ごとにデータがあるなら、B10:D10セル（横に3つのセル）を選択して「=TRANSPOSE(A10:A12)」と入力しCtrlキーとShiftキーを押しながらEnteします。
再度B10:D12セル（3行3列）を選択し、下方向にオートフィルすればご希望のデータが得られますので、そのままCtrl＋Cでコピーし、右クリック「形式を選択して貼り付け」で「値」にしたデータを新規シートのA列に貼り付ければ完成です。

2行ごとのデータは、同様にB10:C10セルを選択し「=TRANSPOSE(A10:A11)」と入力しCtrlキーとShiftキーを押しながらEnteします。
再度B10:C11セル（2行2列）を選択し、下方向にオートフィルして、値貼り付けしたデータのB列をC列に移動すればよいことになります。

お礼

ありがとうございます。
No2ご回答の方に補足していますように、URLやEmailという例外で追加されているものが多く、中々オートフィルでも手間なことがわかり、マクロで対応します。

補足

ありがとうございます。
３×３の方は適用できました。
ただ、２行２列のケースでは、真ん中を一つ飛ばして横に展開したいのですが、方法あるでしょうか。
A10→B10
A11→C10
という様に変換したいです。

回答No.5

kagakusuki

質問締め切り後に失礼致します。回答No.2です。

>VBAを実行して希望の形になりました。ただ、「例外」なデータの所で異常な配列になってしまいます、それを一つ一つ手動で修正、削除するのは大変なため、コードを改善できないでしょうか。

との事でしたので、対応するVBAを組んでみました。(デバッグに時間が掛かり過ぎて御質問の締め切りに間に合いませんでした)
　下記のVBAではセルに入力されている文字列が

〒XXX-XXXX

か或いは

XXX-XXXX

の形式の番号で始まっているもののみを住所と見做して、店名と同じ行のB列のセルに移し、
「(代)」や「(代表)」等の( )付きの文字列(←括弧付きの番号以外)が文頭にある場合には、先頭の括弧で括られている部分を取り除いた上で、残りの部分が、

(0

や

0X-

0XXX

0XX-XXX-

0XX-XXXX-

0XX-XXXXX

という形式の番号や

電話

或いは

tel

で始まっているもののみを電話番号と見做して、店名と同じ行のC列のセルに移し、

url

email

http://

https://

で始まっているもの(大文字や全角文字も含む)や、途中に「@」が含まれているものをURLやメールアドレスと見做して削除し、
上記の条件の何れにも当て嵌まらないものを店名と見做してそのまま残す様になっております。
　尚、１つの店名に対して、住所に該当するデータが複数存在していたり、電話番号に該当するデータが複数存在していたりする様な場合には、先の方に書かれている住所や電話番号が、後に書かれているデータで上書きされて消えてしまわない様にするために、店名と同じ行のD列以降列のセルに順番に移す様にしております。
　ですから、もし複数の住所や複数の電話番号が記載されている店がある場合に備えて、下記のVBAマクロで処理を行った後には、手動操作にてD列に対するオートフィルターを設定し、「(空白セル)」と記された箇所のチェックを外す事で、「D列以降にもデータが存在している行」のみを抽出し、複数ある住所や電話番号の中のどれが正しいデータなのかをチェックする様にして下さい。

Sub QNo9024455_Excelで列に入っているデータを行に展開する方法_改()

Dim FirstRow As Long, NameColumn As String, _
AddressColumn As String, TellColumn As String, _
myRange As Range, c As Range, BackupCell As Range, _
i As Long, tmp, cnt As Long, myIndex As Byte

NameColumn = "A" '名前等の元データが入力されている列の列番号
AddressColumn = "B" '住所を入力する列の列番号
TellColumn = "C" '電話番号を入力する列の列番号
FirstRow = 3 '実際のデータが入力されている最初の行の行番号

Set myRange = Range(Range(NameColumn & FirstRow), _
Range(NameColumn & Rows.Count).End(xlUp))
If myRange.Row < FirstRow Then Exit Sub

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
cnt = -1
For Each c In myRange
cnt = cnt + 1
myIndex = 0
With c
If .Value <> "" And (Not IsError(c)) Then
tmp = Trim(StrConv(.Value, vbLowerCase + vbNarrow))

If tmp Like "(*?)*" And (Not tmp Like "(0*)*") Then _
tmp = Mid(tmp, InStr(tmp, ")") + 1)
If (tmp Like "〒###-####*?" Or tmp Like "###-####*?") And _
Not (tmp Like "###-####-*?" Or tmp Like "###-#####*?") Then
myIndex = 1
'tmp Like "*00090000*?[都,道,府,県]*" Then myIndex = 1
ElseIf .NumberFormatLocal = "[<=99999999]####-####;(00) ####-####" _
And WorksheetFunction.Sum(c) > 9999 Then
myIndex = 1
ElseIf tmp Like "(0*" Or tmp Like "0#-#*" Or tmp Like "0###*" _
Or tmp Like "0##-###-*" Or tmp Like "0##-####-*" Or tmp Like "0##-#####*" _
Or tmp Like "電話*" Or tmp Like "tel*" _
Or (.NumberFormatLocal = "[<=999]000;[<=9999]000-00;000-0000" _
And WorksheetFunction.Sum(c) > 999) Then
myIndex = 2
End If
If tmp Like "url*" Or tmp Like "email*" Or tmp Like "http://*" _
Or tmp Like "https://*" Or tmp Like "*@*" Then myIndex = 255
If myIndex = 0 Then
cnt = 0
Set BackupCell = Cells(.Row, WorksheetFunction. _
Max(Columns(AddressColumn).Column, Columns(TellColumn).Column) + 1)
End If

Select Case myIndex
Case 0
cnt = 0
Case 1
If Range(AddressColumn & .Row - cnt).Value = "" Then
Range(AddressColumn & .Row - cnt).Value = .Value
Else
myIndex = 3
End If
Case 2
If Range(TellColumn & .Row - cnt).Value = "" Then
Range(TellColumn & .Row - cnt).Value = .Value
Else
myIndex = 3
End If
End Select
If myIndex = 3 Then
If BackupCell.Value <> "" Then Set BackupCell = _
Cells(.Row - cnt, Columns.Count).End(xlToLeft).Offset(, 1)
BackupCell.Value = .Value
End If
If myIndex > 0 Then .ClearContents
End If
End With
Next c

On Error Resume Next
myRange.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

回答No.4

MackyNo1

>ただ、２行２列のケースでは、真ん中を一つ飛ばして横に展開したいのですが、方法あるでしょうか。

2行ごとのデータは、すでに回答したようにTRANSPOSE関数を入力しCtrlキーとShiftキーを押しながらEnteし2行2列分を選択し、下方向にオートフィルして、そのままコピーから値貼り付けしたデータのB列をC列に移動（B列のデータ範囲を選択して周囲をC列にドラッグ）すればよいことになります。

＞No2ご回答の方に補足していますように、URLやEmailという例外で追加されているものが多く、中々オートフィルでも手間なことがわかり、マクロで対応します。

どちらかというと、例外が多いようなデータでは、マクロ処理のほうが、元に戻す操作ができないので、かえって面倒なことになるような気がします。

＞例外条件は以下のとおりです。
・ある店にはホームページのURL欄とメールアドレス欄があります。ホームページは"URL http://***"、メアドは、"EMAIL ****"で始まる内容です。これらは横展開に反映する必要がありません。

わざわざ複雑な処理をするのではなく、例外条件のデータは関数やマクロ処理をする前に、不必要なデータは削除する（ワイルドカード検索）または別処理をするのが基本てす。

＞・ある店名は２行にわたっています。
例えば、
　長谷川商店
　（雑貨・金物）
　〒XXX-xxxx ○○県・・・
このような、店名と住所の間の（雑貨・金物）は不要で横展開に反映する必要がありません。

このようなセルも以下のような操作で事前にデータを成型しておきます。

Ctrl＋Hで置換ダイアログを出して「オプション」をクリックし、「セル内の内容が完全に同一なものだけを検索する」のチェックを入れ、検索する文字列に「(*)」と入力して「すべて置換」します。

カッコで挟まれた文字列を削除して上に詰めて表示したい場合は、同条件の「検索」ダイアログで「すべて検索」をクリックし、Ctrl＋Aですべての該当データを選択して、右クリックから「削除」で「上方向にシフト」します。

一般的なデータ処理の方法ですが、このようなデータ形式の異なるデータがどうしてA列に1行にまとめられているのでしょうか。

通常はデータ形式が異なるデータがある場合は、まとめて処理するのではなく、そのデータごとに関数やマクロ処理でデータベースに取り込むような操作をするのが、確実で最も合理的な操作方法だと思います。

回答No.3

bunjii

>店名+電話番号、店名+住所+電話番号　のパターンはある程度かたまっているため、Sheet上で範囲を手動で選択して、行への展開を実行したいと思っています。
A列のデータが最大3行のセットであり、住所の場合は先頭に"〒"があること、電話番号については先頭が"0"である場合に限りますがExcel 2013で検証した結果、次のような数式でデータの展開を行えることが分かりました。
下記の数式はExcel 2010でも再現できるはずです。
店名=OFFSET($A1,0,0)
住所=IFERROR(VLOOKUP("〒*",OFFSET($A1,0,0,3),1,FALSE),"")
電話番号=IFERROR(VLOOKUP("0*",OFFSET($A1,0,0,3),1,FALSE),"")
A列が2行セットのとき展開先のセルを3列×2行を選び、オートフィルコピーで下へ必要個所までドラッグします。
A列が3行セットのとき展開先のセルを3列×3行を選択してオートフィルコピーで下へ必要個所までドラッグします。
すべてのデータが展開できたら展開先の3列すべてを選択し、コピーでクリップボードへ記憶させ、同じ位置へ値のみ貼り付ければ完了です。

回答No.2

kagakusuki

セルに入力されているデータが店名なのか、住所なのか、電話番号なのかをExcelに自動判定させるためには、何らかの基準が必要となります。
　ですから前提条件として、セルに入力されている文字列が住所の場合は必ず「0～9の数字か、或いは"("」で始まっていて、住所の場合は必ず「〒」で始まっていて、店名の場合は最初の文字が「数字や〒、"("」等になっている事は無いものとします。
　それから質問者様が添付された画像の例では、「店名」や「住所」、「電話番号」等といった項目名が入力されている行は何行目であるのかという事や、実際のデータは何行目から始まっているのかという事に関する情報が御座いませんので、取り敢えず仮の話として、実際のデータは3行目以下に入力されているものとします。
　もし上記の前提条件が必ず成り立っている場合には、次の様なVBAを使われると良いと思います。

Sub QNo9024455_Excelで列に入っているデータを行に展開する方法()

Dim myTemp, c As Range, i As Long, myRange As Range, _
FirstRow As Long, NameColumn As String, _
AddressColumn As String, TellColumn As String

NameColumn = "A" '名前等の元データが入力されている列の列番号
AddressColumn = "B" '住所を入力する列の列番号
TellColumn = "C" '電話番号を入力する列の列番号
FirstRow = 3 '実際のデータが入力されている最初の行の行番号

Set myRange = Range(Range(NameColumn & FirstRow), _
Range(NameColumn & Rows.Count).End(xlUp))
If myRange.Row < FirstRow Then Exit Sub

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
i = 0
For Each c In myRange
i = i + 1
With c
If .Value <> "" And Not IsError(c) Then
Select Case InStr("0123456789(〒" & .Value, _
Left(Trim(StrConv(.Value, vbNarrow)), 1))
Case Is < 12
If Range(TellColumn & .Row - i).Value = "" Then
Range(TellColumn & .Row - i).Value = .Value
Else
Cells(.Row - i, Columns.Count).End(xlToLeft). _
Offset(, 1).Value = .Value
End If
.ClearContents
Case 12
If Range(AddressColumn & .Row - i).Value = "" Then
Range(AddressColumn & .Row - i).Value = .Value
Else
Cells(.Row - i, Columns.Count).End(xlToLeft). _
Offset(, 1).Value = .Value
End If
.ClearContents
Case Is > 12
i = 0
End Select
End If
End With
Next c
On Error Resume Next
myRange.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

補足

ありがとうございます。
VBAを実行して希望の形になりました。ただ、「例外」なデータの所で異常な配列になってしまいます、それを一つ一つ手動で修正、削除するのは大変なため、コードを改善できないでしょうか。（電話番号に(代)で始まるものがあり、これは既に対応できており助かりました）
例外条件は以下のとおりです。
・ある店にはホームページのURL欄とメールアドレス欄があります。ホームページは"URL http://***"、メアドは、"EMAIL ****"で始まる内容です。これらは横展開に反映する必要がありません。
・ある店名は２行にわたっています。
例えば、
　長谷川商店
　（雑貨・金物）
　〒XXX-xxxx ○○県・・・
このような、店名と住所の間の（雑貨・金物）は不要で横展開に反映する必要がありません。現状では、２行目のこれが店名になってしまいます。

よろしくお願いいたします。