エクセルマクロで日本語を抽出して転記する方法

お世話になります。
　
　単一セル内に英文＋訳文といったデータがある場合に、同一行の隣のセルに訳文のみ転記するマクロを教えていただきたいのですが。完成形としては、当初のセルに英文のみ、右隣のセルに訳文のみといったものを想定しています。
　
　マクロが組めなければ関数でと考えましたが、データが大量になると自動計算が不可避で（たとえば手動計算にしても保存時等）時間がかかることから、マクロでと考えました。
　
　マクロは初心者ですが、簡単なものでしたら組めますが（今回も、ダブルクリック対応とか、（）内の文字列を削除するとかはできました＞）、抽出がうまく行きません。
　
　お手数をおかけしますが、よろしくご教示下さい。

No.3 ベストアンサー 回答者： tom04 回答日時： 2011/08/08 19:23

No.2です。

投稿後もう一度質問文を読み返してみると
＞完成形としては、当初のセルに英文のみ、右隣のセルに訳文のみといったものを・・・

とありましたので、前回のコードは英字関係のみを抽出するだけでした。
ご希望の方法ではなかったと思いますので、もう一度顔を出しました。

B列に英字関係・C列に日本語を！という感じです。
尚、日本語を抽出するとなるとかなり、条件が多くなってしまいます。
第一水準・第二水準漢字・ひらがな・カタカナ・「ぁぃぅぇぉっゎ」等の促音
「が行・ざ行・・・」等々の濁音などに対応すると大変なので、前回のB列以外をC列にまとめるコードにしてみました。

Sub test() 'この行から
Dim i, k As Long
Dim str, buf1, buf2 As String
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
For k = 1 To Len(Cells(i, 1))
str = Mid(Cells(i, 1), k, 1)
If str Like "[A-z 0-9 . , ! ? ]" Then
buf1 = buf1 & str
Else
buf2 = buf2 & str
End If
Next k
Cells(i, 2) = buf1
Cells(i, 3) = buf2
buf1 = ""
buf2 = ""
Next i
End Sub 'この行まで

これでC列にB列に表示されている文字以外が表示されると思います。

尚、確認の意味で敢えてA列はそのまま残しています。
A列削除は簡単だと思いますので・・・

何度も失礼しました。m(_ _)m

No.5 回答者： kmetu 回答日時： 2011/08/08 20:42

> 私の現状の知識では、悲しいかな、先頭文字か、１文字ずつしか抽出できないのです。

ちょっと、
現在のセルの中身がわからないのですが、たとえば

A1セルに

This is a pen. これはペンです。

とあるとした場合。

For i = 1 To Len(Range("A1").Value)
If AscW(Mid(Range("A1").Value, i, 1)) > AscW("z") Then
Eng = Left(Range("A1").Value, i - 1)
Jpn = Mid(Range("A1").Value, i, Len(Range("a1").Value))
Exit For
End If
Next
Range("A1").Value = Eng
Range("B1").Value = Jpn

といった具合でもよろしいと思うのですが…

この回答へのお礼

kmetu 様ありがとうございました。

先後してしまいましたが、ご指摘の点で解決に至りました。
ご報告が遅れて申し訳ありませんでした。

機会がありましたら、またよろしくお願いします。

お礼日時：2011/08/08 21:07

No.4 回答者： keithin 回答日時： 2011/08/08 19:29

＞単一セル内に英文＋訳文といったデータがある

「I am a boy. 私は少年です。」といった具合に，必ず半角で書かれた英文とそれに続いて日本語の訳文が続いているだけの単純な構図なら
=LEFT(A1,LEN(A1)*2-LENB(A1))
=RIGHT(A1,LENB(A1)-LEN(A1))
などのようにして関数で切り出すのも容易です（再計算で時間が掛かる？ことは無いと思います）が，入り交じって混在しているのでしたら一文字ずつ舐めていくしかありませんね。

＃少しでも具体的なサンプルを挙げてご相談を書いてもらえれば，クイズになることもなくすっきり回答が寄せられます。今後のご参考に。



＃まぁ誰が書いても同じようなマクロにしかなりませんが

sub macro1()
　dim h as range
　dim buf1 as string, buf2 as string, buf as string
　dim i as long

　for each h in range("A1:A" & range("A65536").end(xlup).row)
　　buf1 = ""
　　buf2 = ""
　　for i = 1 to len(h.text)
　　　buf = mid(h.text, i, 1)
　　　if strconv(buf, vbwide) = buf then
　　　　buf2 = buf2 & buf
　　　else
　　　　buf1 = buf1 & buf
　　　end if
　　next i
　　h.offset(0, 1) = buf1
　　h.offset(0, 2) = buf2
　next
end sub

この回答へのお礼

keithin 様　ありがとうございました。

tim04 様とお二方の回答を参考に解決できました。
tim04 様が時間的に早く、２回も回答していただきましたので、
ベストアンサーにさせていただきました。

機会がありましたら、またよろしくお願いします。

お礼日時：2011/08/08 21:05

No.2 回答者： tom04 回答日時： 2011/08/08 18:27

こんばんは！

VBAでの一例です。

A列の1行目からデータがあり、「英字」「数字」「？」「.」「,」「！」（←すべて半角）及び半角スペースを
B列に表示するとします。

一文字ずつ舐めるように検索していますので、少し時間がかかるかもしれません。

画面左下にある操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面が出ますので
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub test() 'この行から
Dim i, k As Long
Dim str, buf As String
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
For k = 1 To Len(Cells(i, 1))
str = Mid(Cells(i, 1), k, 1)
If str Like "[A-z 0-9 . , ! ? ]" Then
buf = buf & str
End If
Next k
Cells(i, 2) = buf
buf = ""
Next i
End Sub 'この行まで

※　尚、他にも表示したい文字があれば
If str Like "[A-z 0-9 . , ! ? ]" の部分内で、半角スペースの後に追加すれば大丈夫です

他に良い方法があればごめんなさいね。m(_ _)m

この回答へのお礼

tom04 様　ありがとうございました。
参考になりました。
特に、mid の存在をすっかり忘れていました。

ご教示いただいた内容から、
１文字づつなめるのではなく、
正規表現で、単に日本語のFirstindex を Mid の切り出し位置に指定して、
それ以降の文字列を転記という方法にまとめました。

ありがとうございました。
機会がありましたら、またよろしくお願いします。

お礼日時：2011/08/08 21:08

No.1 回答者： kmetu 回答日時： 2011/08/08 17:03

英文と訳文に特殊な区切りとかつけていないのでしょうか？

つけていれば Splitを利用するとかInStrとRightやMid、Leftなど組み合わせて利用することができます。

また、単純にセルの文字列の文字コードを一文字ずつ調べて（AscW)日本語が出現したところで分割すると言う方法が考えられます。

この回答へのお礼

お世話になります。早速のご回答ありがとうございます。

ご指摘の点、当初は空白をターゲットにしてと思ったのですが、
WEBから英作文や単語をコピペしたので、サイトによっては必ずしも空白を設けておらず、
また文とは限らないので「.」もターゲットにできませんでした。

そこで、正規表現を使用するしかないのではと思っているのですが、
パターンを[^\x01-\x7E\xA1-\xDF]" とすれば、何とか日本語は切り出せるのですが、
私の現状の知識では、悲しいかな、先頭文字か、１文字ずつしか抽出できないのです。

現状のご報告としては、参考になりましたでしょうか。

お礼日時：2011/08/08 17:13