Excel 文字の抽出と表示に関して

質問

以下のテキスト部分をExcelに全値張りして、
自動的に横一列に表記されるようにしたいのですが、
どのように関数を組めばいいのか教えてください。

ひとまずCOUNTIFで項目を引っ張ってきて、
MIDで「：」以降を表示するまではできたのですが…ギブアップです。
どなたか関数のご教示お願いします。

★使用ソフト：EXCEL2010

例文テキスト-------------------------

会社名：ABC
電話番号：012-345-6789
電話番号：012-345-4567
URL：http://www.yahoo.co.jp

-------------------------------------

※1「名前」「電話番号」の横には必ず全角の「：」がつく
※2　電話番号は２、３つ記入される場合もある

最終的に、同シート内で↓

セル列1　　セル列2　　　　　セル列3
ABC　　　012-345-6789　　http://www.yahoo.co.jp

というように、一行で表記したいのです。

もし可能であれば、二つ目の電話番号も
2行目に表示されるようにしたいのですが…

回答No.2

tom04

こんにちは！
VBAになってしまいますが、一例です。
Sheet1のデータをSheet2に表示するようにしてみました。
条件として、Sheet1のA列1行目からデータがあり
「会社名」「電話番号」「URL」の文字は必ず入っているという前提です。

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から
Dim i As Long, k As Long, j As Long, cnt As Long, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
Application.ScreenUpdating = False
On Error Resume Next
For i = 1 To wS1.Cells(Rows.Count, 1).End(xlUp).Row '1行目～A列最終行まで
If InStr(wS1.Cells(i, 1), "会社名") > 0 Then
cnt = cnt + 1
k = i
Do Until InStr(wS1.Cells(k, 1), "URL") > 0
k = k + 1
Loop
Range(wS1.Cells(i, 1), wS1.Cells(k, 1)).Copy
wS2.Cells(cnt, 1).PasteSpecial Paste:=xlValues, Transpose:=True
For j = 1 To wS2.Cells(cnt, Columns.Count).End(xlToLeft).Column
With wS2.Cells(cnt, j)
.Value = Mid(.Value, InStr(StrConv(.Value, vbNarrow), ":") + 1, Len(.Value))
End With
Next j
j = wS2.Cells(cnt, Columns.Count).End(xlToLeft).Column
If j > 3 Then
Range(wS2.Cells(cnt, 3), wS2.Cells(cnt, j - 1)).Copy
wS2.Cells(cnt + 1, 2).PasteSpecial Paste:=xlValues, Transpose:=True
Range(wS2.Cells(cnt, 3), wS2.Cells(cnt, j - 1)).Delete shift:=xlToLeft
cnt = wS2.Cells(Rows.Count, 2).End(xlUp).Row
End If
End If
Next i
wS2.Columns.AutoFit
Application.ScreenUpdating = True
End Sub 'この行まで

こんな感じではどうでしょうか？m（_ _）m

※　セル内に「会社名」という文字があれば「URL」という文字があるまでループしていますので、
もし「URL」のセルがない場合はマクロが止まってしまいます。m（_ _）m

回答No.1

某HN クロメート(Chromate)（@CoalTar）

C2セルに
=CHOOSE(MATCH(A2,{"会社名","電話番号","URL"},0),COUNTIF(A$1:A2,"会社名")*100,IF(A1="電話番号",C1+1,C1+10),ROUND(C1+10,-1))
下へオートフィル(フィルハンドルダブルクリック)

E列 連番
F2セルに =MATCH(E2*100,C:C,0)
G2セルに =IF(ISNA(F2),"",INDEX(B:B,F2))
H2セルに
=IF(G2="","",SUBSTITUTE(TRIM(INDEX(B:B,F2+1)&" "&
IF(INDEX(C:C,F2+2)<>E2*100+11,"",INDEX(B:B,F2+2))&" "&
IF(INDEX(C:C,F2+3)<>E2*100+12,"",INDEX(B:B,F2+3)))," ",CHAR(10)))
I2セルに
=IF(G2="","",INDEX(B:B,MATCH(E2*100+20,C:C,0)))
F2:I2セル を下へオートフィル
F:Iセルを切り取って、別シートへ貼り付け
添付図参照 参考まで