人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

データベースの中から「団体の名称」と「電話番号」だけ抜き出したいのですが可能でしょうか?

文字や項目がキレイに整っているなデータベースではなく、
縦が4行ぐらいのデータが多く
横の文字数がデータによってばらつきがあります。

使用できるソフトはexcelとtxtとします。
データベースはtxt形式です。

<例>

36

82優生○○○改悪○○会
東京都○○市荒木門町64-4 ○○内
0*-3**3-**74

37
NGO○○準備会

38
国際○○情報センター (住所非公開)
*3-5**5-**88

基本的には「1行目・・・データ番号」「2行目・・・名称」「3行目・・・住所」
「4行目・・・電話番号」+1行空白、というデータが多いです。
何千もデータがあり、とても手作業ではこなせません。。。

もし名称と電話番号だけ抽出するのが難しいようでしたら、
電話番号だけでも構いません。

どうぞよろしくお願い致します。

●質問者: MAYARAN
●カテゴリ:ビジネス・経営 経済・金融・保険
✍キーワード:Excel txt キレイ センター ソフト
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● hiko3karasu
●150ポイント

じゃあ、txtを取り込んでA列にデータが入っているとします。

B列を計算用に使います

B1に1

B2に

=IF(A2=A$1+SUM(B$1:B1),1,"")

B3以降にB2をコピーしてください。

C1に

=IF(B1=1,A1,"")

D1に

=IF($B2=1,"",IF($B1=1,$A2,""))

E1に

=IF(D1="","",IF($B3=1,"",IF($B1=1,$A3,"")))

F1に

=IF(E1="","",IF($B4=1,"",IF($B1=1,$A4,"")))

といれて、それぞれ、下の行にコピーします。

C列からF列を選択して「コピー」を選んで、別のシートで「形式を選択して貼り付け」を選んで「値」を選んで貼り付けてください。

データ番号の列で並べ替えをすると番号順のデータができると思います。

4番目の列に電話番号があると思います。

4行でないデータは違うところに電話番号があると思います。

また、電話番号だけ出せばいいのならば、

txtを取り込んでA列にデータが入っている時に並べ替えを行って、0から始まっている番号が電話番号になると思いますがどうでしょう?

◎質問者からの返答

ご回答ありがとうございます!

原理は理解出来ませんが、指示通りにやってみるとそのようにデータが整理されました。

他のシートに貼り付けたら全てリスト化されました。

お忙しい中、貴重なお時間を使っていただいてありがとうございます。

「それぞれ、下の行にコピーします。」

の点なんですが、これはB1、B2、C1、D1、E1、F1のセルを選択して

その他のデータ番号のセルに貼り付けていくということでしょうか?

これは・・・何千の貼り付けを手作業しなければいけませんか??

それともオートでできる機能があるのでしょうか?

無知で申し訳ありません。どうぞご教授ください。。。


2 ● SALINGER
●150ポイント ベストアンサー

ExcelVBAでテキストからデータを取り出すマクロを作ってみました。


ExcelVBAを使ったことがなければ以下を参考にしてみてください。

http://www.officepro.jp/excelvba/ini/index1.html

http://www.officepro.jp/excelvba/ini/index2.html

http://www.officepro.jp/excelvba/ini/index3.html


データ番号は1番から通し番号がついているとします。

データ番号、名称、(いろいろ)、電話番号の順番になっているとします。

間に空白行とかがあっても大丈夫です。

以下のマクロを貼り付けて、テキストファイルのパスを直して、実行すると

シートのA列に名称、B列に電話番号を抽出します。


Sub Macro()
  ' データファイルのパスを指定
 Const FILENAME = "C:\Documents and Settings\hogehoge\デスクトップ\hatena\test.txt"
 Dim FSO
 Dim TS
 Dim str As String
 Dim i As Long
 Dim f As Boolean
 Dim Meisyou As String
 Dim RE
 Dim reMatch
 
 Set RE = CreateObject("VBScript.RegExp")
 RE.Pattern = "\d{1,4}?-\d{1,4}?-\d{1,4}"
 
 Set FSO = CreateObject("Scripting.FileSystemObject")
 Set TS = FSO.OpenTextFile(FILENAME, 1)
 i = 1
 Do Until TS.AtEndOfStream
 str = TS.ReadLine
 If f Then
 If str = CStr(i + 1) Then
 Cells(i, 1).Value = Meisyou
 
 Meisyou = ""
 i = i + 1
 Else
 If str <> "" Then
 If Meisyou = "" Then
 Meisyou = Trim(str)
 Else
 Set reMatch = RE.Execute(str)
 If reMatch.Count > 0 Then
 Cells(i, 1).Value = Meisyou
 Cells(i, 2).Value = reMatch(0)
 
 Meisyou = ""
 f = False
 i = i + 1
 End If
 End If
 End If
 End If
 Else
 If str = CStr(i) Then
 f = True
 End If
 End If
 Loop
 
 TS.Close
 Set TS = Nothing
 Set FSO = Nothing
 Set RE = Nothing
End Sub
◎質問者からの返答

ご回答ありがとうございます!

・・・すごいですね。。。私には全く理解不能なレベルです(^?^;

わざわざすいません。感謝しております。

「テキストファイルのパスを直して」という部分なのですが

これはどのような操作を行なえばよろしいのでしょうか?

試しにテキストのデータ名+拡張子名を入力してみたのですが、

「パスが見つかりません」と表示されてしまいます。。。

「使用できるソフトはエクセルとテキスト」と記載しましたが

私個人が使用できるということではなく、

私の使っている環境がエクセルとソフトを使える、というレベルでして・・・

でも記載していただいたページの説明は非常に分かりやすく丁寧でした。

探していただいてありがとうございます。

お手すきの際にご回答いただけるとうれしいです。


3 ● SALINGER
●150ポイント

データ番号が全角、最初が1以外、途中抜けてても対応。

ただし、名称や住所、電話番号に数値だけがあると、それもデータ番号と認識してしまう欠点があります。

Sub Macro()
  ' データファイルのパスを指定
 Const FILENAME = "C:\Documents and Settings\hogehoge\デスクトップ\hatena\test.txt"
 Dim FSO
 Dim TS
 Dim str As String
 Dim i As Long
 Dim f As Boolean
 Dim Meisyou As String
 Dim RE
 Dim reMatch
 
 Set RE = CreateObject("VBScript.RegExp")
 RE.Pattern = "\d{1,4}?-\d{1,4}?-\d{1,4}"
 
 Set FSO = CreateObject("Scripting.FileSystemObject")
 Set TS = FSO.OpenTextFile(FILENAME, 1)
 i = 1
 Do Until TS.AtEndOfStream
 str = TS.ReadLine
 If f Then
 If IsNumeric(str) Then
 Cells(i, 1).Value = Meisyou
 
 Meisyou = ""
 i = i + 1
 Else
 If str <> "" Then
 If Meisyou = "" Then
 Meisyou = Trim(str)
 Else
 Set reMatch = RE.Execute(str)
 If reMatch.Count > 0 Then
 Cells(i, 1).Value = Meisyou
 Cells(i, 2).Value = reMatch(0)
 
 Meisyou = ""
 f = False
 i = i + 1
 End If
 End If
 End If
 End If
 Else
 If IsNumeric(str) Then
 f = True
 End If
 End If
 Loop
 
 TS.Close
 Set TS = Nothing
 Set FSO = Nothing
 Set RE = Nothing
 MsgBox "終了"
End Sub
◎質問者からの返答

すごい!何千もあったデータが全部リストに・・・(T_T)

ありがとうございます!

半分ほど電話番号の代わりに住所の番地が記載されているのですが

これで5000程度のリストを得ることができました。

・・・この住所の番地が表示されてしまっている分のデータは

マクロではどうにもならない部分なんでしょうか?

私に知識があればもう少し突っ込んだ質問ができるのですが・・・

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ