マクロを使ってデータを取り出す方法を教えてください

質問

マクロについてどなたか教えて頂けないでしょうか。
何卒、よろしくお願い致します。

1つのセルに以下のようなデータが入っています。
改行は「Alt」+「Enter」で改行されています。

【やりたいこと】
1つのセルに入っているデータ2行目にある
動物園情報：●●（数字）←この数字部分を
B列に取り出したいのです。※半角()内の数字。

もし数字のみを取り出すことが出来ないのであれば
2行目ごとB列に取り出す形でも構いません。
どなたか助けて頂けますでしょうか。
どうぞよろしくお願い致します。

　　　　　　　　　　A
-------------------------------------------------------
　｜軽井沢動物園
　｜動物園情報：軽井沢（123456）
1 ｜ここの動物園はアクセスもよく子連れでも大変便利な上
　｜大人同士でも楽しく過ごせるところです。
　｜ぜひ遊びにきてください。(存分に楽しめます)
-------------------------------------------------------
　｜上野動物園
　｜動物園情報：上野（985412）
2 ｜ここの動物園はアクセスもよく子連れでも大変便利な上
　｜大人同士でも楽しく過ごせるところです。
　｜ぜひ遊びにきてください。
　｜12/10（木）は休園日です。
-------------------------------------------------------

【完成形イメージ】
　　　　　　　　　　A　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　B
-------------------------------------------------------　
　｜軽井沢動物園 　　　　　　　　　　
　｜動物園情報：軽井沢（123456） 　　　　　　　　
1 ｜ここの動物園はアクセスもよく子連れでも大変便利な上　　　　　　　　　123456
　｜大人同士でも楽しく過ごせるところです。 　　　　　　　
　｜ぜひ遊びにきてください。 (存分に楽しめます) 　　　　　　　
-------------------------------------------------------
　｜上野動物園
　｜動物園情報：上野（985412）
2 ｜ここの動物園はアクセスもよく子連れでも大変便利な上 　　　　　　　　985412
　｜大人同士でも楽しく過ごせるところです。
　｜ぜひ遊びにきてください。
　｜12/10（木）は休園日です。
-------------------------------------------------------

回答No.6

jcctaira · ベストアンサー

nanacolobiyaokさん
はじめまして。
ちょっと技術的になりますが知っていると便利な方法で回答します。
今回は関数として作成してあります。
使用方法は
B1に =数字抽出(A1)

Function 数字抽出(セル As Range) As String
　Dim RE　　　As Object
　Dim MC　　　As Object
　Set RE = CreateObject("VBScript.RegExp")
　RE.Pattern = "((\d+))"
　Set MC = RE.Execute(Split(セル, vbLf)(1))
　If MC.Count >= 1 Then 数字抽出 = MC(0).SubMatches(0)
　Set RE = Nothing
　Set MC = Nothing
End Function

ちょっと解説
1.Split(セル, vbLf)(1)
セル内改行を分割して２行目だけとり出しています。
　※配列は０から始まるので(1)は２行目です。
2.正規表現
　この説明すると長くなりますので、ネットで調べてください。
　RE.Pattern = "((\d+))"
　(数字) の数字部分を抽出しています。(\d+)は \d…数字　+…連続　
　MC(0).SubMatches(0)　パターンマッチした１つ目を取り出します。

※慣れれば、すっきりしたプログラムになります。
　お試しください。

お礼

お礼が大変遅くなりまして本当に申し訳ございませんでした。
頂きましたマクロで綺麗に抽出することができました。

正規表現を使うのですね。
RE.Pattern = "((\d+))"

早速調べてみました。

お礼が遅くなりましたお詫びとご回答のお礼を
させて頂きます。本当にありがとうございました。

回答No.5

imogasi

VBAということなのでヒントを挙げておく。推測して勉強のこと
A1セルに
軽井沢動物園
動物園情報：軽井沢（12356）
ここの動物園はアクセスもよく子連れでも大変便利な上
大人同士でも楽しく過ごせるところです。
ぜひ遊びにきてください。(存分に楽しめます)
改行部はChr(10)で改行されている「。
（　）は全角とする。反核なら下記の（)を反核に変えろ。
ーー
Instr関数をすすめる。
（）内は数字と仮定する。IsNumericで数字チェックは簡単。
Sub test02()
x = Cells(1, 1)
p = InStr(x, Chr(10))
MsgBox p
s = p + 1
p1 = InStr(s, x, "（")
MsgBox p1
s = p1 + 1
p2 = InStr(s, x, "）")
MsgBox p2
y = Val(Mid(x, p1 + 1, p2 - p1 + 1))
MsgBox y
Cells(1, 2) = y
End Sub
ーー
x = Cells(1, 1)
を色々変えてやってみて
納得したらMsgbox を取り除け。
そしてＡ列最終行ｄを求め
For i=1 to d
ｘ＝Cellｓ（i,”A")
処理
Next i
でA列の全行の処理をすること。
ーー
質問から推測して仮定していることは沢山在るはとりあえず。
関数でも出来そうな内容だ。なぜＶＢＡ？

お礼

お礼が大変遅くなりまして本当に申し訳ございませんでした。
VBAを勉強中のため、どうしてもデータを抽出したかったのです。
でも関数での抽出方法も存じ上げませんでした。

今回皆様からご教示いただき本当に勉強になりました。

またimogasi様より頂きました処理で早速実践し、
綺麗にデータを抽出することもできました。
応用がきかせれるよう内容を十分理解してまいりたいと思います。

本当にありがとうございました。

回答No.4

list

＃２です。

VALUE(MID(A3,x.y))の後半(y)を
FIND(")",A3,1)
を用いれば、出来ませんか？

または、
TRIM
関数を使って、余分な、空白を削除する。

回答No.3

DIooggooID

必ず上記の書式であれば、・・・　二行目の　（）　の中を表示

B1には、
=MID(A1,(FIND("（",A1,(FIND(CHAR(10),A1)))+1),(FIND("）",A1,(FIND(CHAR(10),A1))))-(FIND("（",A1,(FIND(CHAR(10),A1))))-1)

B2には、
=MID(A2,(FIND("（",A2,(FIND(CHAR(10),A2)))+1),(FIND("）",A2,(FIND(CHAR(10),A2))))-(FIND("（",A2,(FIND(CHAR(10),A2))))-1)

この関数を設定してください。

お礼

早速のご回答まことにありがとうございました。
マクロでやりたかったのですが、急ぎでデータを取り出したかったので
頂きました関数で活用させていただきました。
関数でこんなデータを抜き出すことができるなんで目から鱗です。

改めて関数も勉強しなくてはと思った次第です。

本当に本当にありがとうございました。

回答No.2

list

私なら、マクロを使用するのではなく、以下のとおり計算式を入力します。

Ａ３：動物園情報：軽井沢（123456）
Ｂ３：=IF(MID(A3,1,5)="動物園情報",VALUE(MID(A3,FIND("（",A3,1)+1,LEN(MID(A3,FIND("（",A3,1)+1,99))-1)),"")

お礼

関数を使ってできるのです。
早速のご回答ありがとうございます。

ただ、A3に入っている値が「動物園情報：軽井沢（123456） 」のみであれば
「123456」を別のセルに抜き出す事ができるのですが、
A3には「Alt」+「Enter」で改行されたデータが何行もあり、それが入ると
上手く数字だけを抜き出すことができないのです。。

回答No.1

noname#158634

MIDとFINDかSEARCH関数じゃダメなんですか？
どうしてもマクロがいいならInｓｔｒ関数。とMID関数。
どちらも数字までに半角丸かっこが出ない前提。

お礼

早速のご回答ありがとうございます。
マクロを勉強中の為、マクロで作成したいと思っております。
Inｓｔｒ関数とMID関数を使って作るのですね。
少し調べてやってみます。
ありがとうございました。