Excel2003で、映画の邦題と原題が、続けてセル内にあります。殆ど

Excel2003で、映画の邦題と原題が、続けてセル内にあります。殆どは間にスペースを開けてます。
これを、邦題、原題（英語）をそれぞれ別のセルに分けるのはどうすれば良いのでしょうか？
又、セル内の位置は不確定ですが、括弧内に製作年を入れてます。これも別セルに貼り付ける方法も、合わせてご教示下さい。
どうぞ宜しくお願い致します。
例　　　［ザ・ワイルド（1997)　THE EDGE　］→[ザ・ワイルド]　[THE EDGE]　[1997]

No.5 ベストアンサー 回答者： mt2008 回答日時： 2010/07/22 12:04

ANo.1です。

無理やりVBAで作って見ました。
半分勉強で作ったので、あまり良いコードとは言えませんし、質問者のご理解を超えているかも知れませんが、ご参考までに。
A2：A10に入っている元データをB列に邦題、C列に原題、D列に作成年を入れています。

括弧やスペースに全角・半角が混じるとやりにくいので、全て半角にしてから処理しています。
そのせいでカタカナも半角になってしまいますが、その辺は手抜きをして半角のままにしています。

原題は、英数字と記号だけで構成されていると言う前提です。中国映画など、全角の原題があるとNGです。
邦題は、元データをスペースで区切って英数字と記号以外が入っている箇所から前。ただし、1番目の区切りは絶対に邦題。
＃　AB CD いい AB CD EE　→　邦題:AB CD いい 原題：AB CD EE
＃　AB CD EE AB CD EE　→　邦題:AB 原題：CD EE AB CD EE

製作年は、(1???)か（2???)　を満たす4桁の数字です。
なお、正規表現を使いますので「Microsoft VBScript Regular Expressions 5.5」を参照設定してください。

また、当然ですが、これで完璧に振り分けられるわけでは有りませんので、最終的には手で修正する必要が有ります。

Sub TEST()
　Dim RE, rWork, m
　Dim r, sTitle, sData, sHou, sGen, sYear, i, nYs, sNarrow, sNarrowR
　Set RE = CreateObject("VBScript.RegExp")　'正規表現用
　With RE

　　For Each r In Range("A2:A10") '対象セル範囲
　　　sHou = ""
　　　sGen = ""
　　　sYear = ""
　　　nFlag = 0
　　　
　　　sTitle = StrConv(r.Value, vbNarrow) '全部半角に変換
　　　If sTitle = "" Then Exit Sub
　　　
　　　'製作年があれば抜き出す
　　　.Global = False
　　　.Pattern = "\([1-2][0-9][0-9][0-9]\)"
　　　Set rWork = .Execute(sTitle)
　　　For Each m In rWork
　　　　 sYear = m.Value
　　　　 sTitle = .Replace(sTitle, "")
　　　　 sYear = Mid(sYear, 2, 4)
　　　Next m
　
　　　'半角スペースで区切る
　　　sData = Split(sTitle, " ")
　　　
　　　'区切った物を後ろからチェック
　　　For i = UBound(sData) To 1 Step -1
　　　　'区切った物の中に英数字+記号が入っている？
　　　　sNarrow = StrConv(sData(i), vbNarrow) '半角に変換
　　　　.Global = True
　　　　.Pattern = "[^!-~]"　'英数字と記号以外を抜き出すパターン
　　　　sNarrowR = .Replace(sNarrow, "")　　'更に正規表現で英数字+記号のみに
　　　　If StrComp(sNarrow, sNarrowR) <> 0 Then nFlag = 1
　
　　　　If nFlag = 0 Then
　　　　　sGen = sData(i) & " " & sGen
　　　　Else
　　　　　sHou = sData(i) & " " & sHou
　　　　End If
　　　Next i
　　　sHou = sData(0) & " " & sHou
　　
　　　'セルに表示
　　　r.Offset(0, 1).Value = Trim(sHou)
　　　r.Offset(0, 2).Value = Trim(sGen)
　　　r.Offset(0, 3).Value = sYear
　　　
　　　
　　Next r
　
　End With
　Set RE = Nothing

End Sub

この回答へのお礼

有難うございました。ご回答を理解するのに手間取りまして、御礼が遅くなってしまいました。
改めてマクロを勉強しなおします。
お世話になりました。

お礼日時：2010/07/27 09:18

No.6 回答者： mt2008 回答日時： 2010/07/22 18:11

先ほどの回答の訂正です。

> なお、正規表現を使いますので「Microsoft VBScript Regular Expressions 5.5」を参照設定してください。

と、書きましたが、CreateObjectを使っていたので参照設定不要でした。失礼しました。

No.4 回答者： mu2011 回答日時： 2010/07/21 11:23

NO2です。

>このFIND関数は”（”の前までの文字数を指定してるのでしょうか？
　⇒この場合、最左端からの左括弧の位置なので「－１」して邦題の文字数としています。


>説明不足でしたが、括弧で括った年代が無いものもありますし、原題の後ろになってるのもあります。
　⇒この条件を明確にする事が肝心です。

>日本語部分、英語部分を抽出出来ないかと希望して質問しました。
　⇒私は、年代が日本語と英語部分を切り分けられると解釈して提案しましたが、切り分け条件が数パータンあるのであれば、どの方法を選択しても一括にはできませんので各回答を組み合わせてお試しください。
　　
　
　　
　　

No.3 回答者： imogasi 回答日時： 2010/07/20 20:29

エクセルの基本機能で

データー区切り位置ースペースでやるのは常識です。
これでＡ，Ｂ列２列に分かれたらＢ列でカッコ（で分けてみること。２段操作。
ここまでぐらいやって、うまく行かない点は質問すべき程度の問題。
最後の）は置換で消すとか。

この回答への補足

有難う御座いました。
スペース区切りは、列全体をまとめて実行する方法が分からなかったのですが、改めて調べてみてLEFT関数で出来そうです。但し、邦題内にも、原題内にもスペースがある場合が有ります。実行してみて手で補正する箇所が多ければ質問し直します。
英語部分、日本語部分を抽出するのはVBAを使わないと無理なのでしょうか？

補足日時：2010/07/20 22:17

No.2 回答者： mu2011 回答日時： 2010/07/20 15:31

一例です。

（１）データはA2以下に入力されている事とし、B2、C2、D2に抽出します。
　B2に=MID(A2,1,FIND("（",A2)-1)
　C2に=TRIM(MID(A2,FIND(")",A2)+1,LEN(A2)))
　D2に=MID(A2,FIND("（",A2)+1,4)
　B2:D2を選択して下方向にコピー

（２）FIND関数での括弧文字列は全角としていますので相違していれば調整して下さい。
（３）抽出セルは数式の為、これをデータとして取り扱う場合、抽出範囲をコピー→形式を選択して貼り付け→値を選択→ＯＫとして下さい。

この回答への補足

有難う御座いました。
MID関数では、先頭位置は指定出来ますが、文字数の指定が分からなかったのですが、このFIND関数は”（”の前までの文字数を指定してるのでしょうか？説明不足でしたが、括弧で括った年代が無いものもありますし、原題の後ろになってるのもあります。
日本語部分、英語部分を抽出出来ないかと希望して質問しました。

補足日時：2010/07/20 17:15

No.1 回答者： mt2008 回答日時： 2010/07/20 14:31

必ず括弧でくくられた製作年が入っているのでしたら、[データ]→[区切り位置]で括弧を区切り文字に指定して区切っては？

1.「邦題（製作年）原題」が入っている列を対象にメニューの[編集]→[置換]で、「）」を「（」に置換（データ区切りを一回で行うための小細工）
2.メニューの[データ]→[区切り位置]で「カンマやタブなどの区切り文字によって……」を選択して＜次へ＞
3.区切り文字「その他」を選択して「（」を入力して＜完了＞

これで、「邦題」「製作年」「原題」に分かれます。
ただし、括弧が入っているタイトルはおかしな区切り方になってしまいますので、それは手で直しましょう。

この回答への補足

有難う御座いました。
必ずしも入ってるわけでは有りません。5000近くデータが在りますが、入ってない方が多いいです。
年代を拾い出すのに、括弧で括った部分を抽出する方法は在りますでしょうか？
どうぞ宜しくご教示下さい。

補足日時：2010/07/20 17:20