エクセルでアルファベットと日本語の文字列を分割する方法

エクセルで各セルに
"Beatlesビートルズ"
"Rolling Stonesローリング・ストーンズ"
のような英語とカタカナ表記がつながっている（間にスペース等ない）文字列を
"Beatles" "ビートルズ"
"Rolling Stones" "ローリング・ストーンズ"
のように分割する方法はありますでしょうか
データが少なければコピペですみますが
何千件になるととてもやってられません
関数もしくはＶＢＡで可能であれば教えてください
データは同じ列に縦に並んでいます

No.8 ベストアンサー 回答者： Wendy02 回答日時： 2006/09/30 01:37

こんばんは。

Wendy02です。

#3 のマクロの訂正です。しかし、次のマクロのほうがスピードは速いはずです。

'----------------------------------
　'出力する列は？
　Const OUTPUTCOL As String = "C"
　'----------------------------------
　
　iCol = Columns(OUTPUTCOL).Column　　'← 入れ替え
　
　Set rng = Range("A1", Range("A65536").End(xlUp))　'←入れ替え
　Application.ScreenUpdating = False

　　↓
　　以下のようになります。

　Set rng = Range("A1", Range("A65536").End(xlUp))
　
　iCol = Columns(OUTPUTCOL).Column - rng.Column
　

'----------------------------------------------------------------
なお、混在した場合のものも作っておきました。
ローリング・ストーンズRolling Stones
Rolling Stonesローリング・ストーンズ
でも、両方とも切り分けるように作りました。
'---------------------------------------------------------------


Sub reSeparateAlphabetKana()
'英語・カタカナ混在の場合に区切るマクロ
Dim rng As Range
Dim c As Range
Dim iCol As Long
　'----------------------------------
　'出力する列は？
　Const OUTPUTCOL As String = "B"
　'---------------------------------
　
　Set rng = Range("A1", Range("A65536").End(xlUp))
　
　iCol = Columns(OUTPUTCOL).Column - rng.Column
　
　Application.ScreenUpdating = False
　
　For Each c In rng
　　 If VarType(c.Value) = vbString Then
　　　 c.Offset(, iCol).Resize(, 2).Value = reSplit(c.Value)
　　 End If
　Next c
　Application.ScreenUpdating = True
End Sub
Function reSplit(strText As String) As String()
'英語・カタカナを分離する関数
Dim Matches As Object
Dim Match As Object
Dim buf(1) As String
With CreateObject("VBScript.RegExp")
　.Pattern = "^([A-z ]+|[ぁ-龠 ]+|[\uFF64-\uFF9F ]+|[Ａ-ｚ ]+)"
　'\uFF64-\uFF9F 半角カタカナ 注意：パターンには半角空白が一つ入る
　.Global = False
　'全角空白は紛れ込ませない
　strText = WorksheetFunction.Substitute(strText, "　", " ")
　Set Matches = .Execute(strText)
　If Matches.Count Then
　　 Set Match = Matches(0)
　　 buf(0) = Match.Value
　　 buf(1) = Replace(strText, Match.Value, "")
　End If
　reSplit = buf()
End With
End Function

No.7 回答者： Wendy02 回答日時： 2006/09/30 00:47

こんばんは。

Wendy02です。

失礼しました。
=MID(A1,1,MATCH(TRUE,INDEX(CODE(MID(A1,ROW($A$1:$A$256),1))<224,,),0)-1)


一応、これでよいと思います。　224というのは、文字コードの半角カタカナの最後に文字に1足した数です。

この現象は、良く調べてみないと分かりませんが、文字の比較に関しては、ワークシート上では、何か、特別な仕掛けがあるようです。

No.6 回答者： Wendy02 回答日時： 2006/09/29 22:26

こんばんは。

#3 のWendy02 です。
数式の場合は、こんに風に、等式を変えればよいと思います。
"ぁ"にした理由は特にありません。"ァ"でもよいのですが、"ぁ"のほうが小さいからです。

C列
=MID(A1,1,MATCH(TRUE,INDEX(MID(A1,ROW($A$1:$A$256),1)<"ぁ",,),0)-1)

D列に出力　（こちらは同じです)
=SUBSTITUTE(A1,C1,"")


マクロは、17行目あたりの以下のコードを
　　If StrComp(StrConv(Mid(c.Value, i, 1), vbNarrow), "~") > 0 Then
　　↓
　　If StrComp(StrConv(Mid(c.Value, i, 1), vbNarrow), "ぁ") < 0 Then

に変えればよいです。


なお、混在している場合の切り分けは、また、ここの回答の補足などでご相談ください。

この回答への補足

ありがとうございます

ただ、これですと
ローリング・ストーンズRolling Stonesが
"ローリング"　"・ストーンズRolling Stones"
となってしまいます

補足日時：2006/09/29 22:51

No.5 回答者： mike_g 回答日時： 2006/09/29 21:20

No.3さんのアイデアを拝借すれば、No.4の B1 の式は次式でもＯＫかと。

B1: =LEFT(A1,MATCH(TRUE,(MID(A1,ROW(INDIRECT("1:"&LEN(A1))),1))>"z",0)-1) (配列数式)

No.4 回答者： mike_g 回答日時： 2006/09/29 21:14

B1: {=LEFT(A1,MATCH(TRUE,CODE(MID(A1,ROW(INDIRECT("1:"&LEN(A1))),1))>160,0)-1)} (配列数式)

C1: =SUBSTITUTE(A1,B1,"")

この回答へのお礼

ありがとうございました

お礼日時：2006/09/29 23:06

No.3 回答者： Wendy02 回答日時： 2006/09/29 21:09

こんばんは。

A列の1行目からデータがあるとします。

C列に出力
=MID(A1,1,MATCH(TRUE,INDEX(MID(A1,ROW($A$1:$A$256),1)>"z",,),0)-1)

D列に出力
=SUBSTITUTE(A1,C1,"")



マクロなら、こんなものが簡単でもよいかも……

Sub SeparateAlphabet()
'アルファベットと日本文字とを分離するマクロ
　Dim rng As Range
　Dim i As Long
　Dim c As Range
　Dim iCol As Long
　
　'----------------------------------
　'出力する列は？
　Const OUTPUTCOL As String = "C"
　'----------------------------------
　
　iCol = Columns(OUTPUTCOL).Column
　
　Set rng = Range("A1", Range("A65536").End(xlUp))
　Application.ScreenUpdating = False
　For Each c In rng
　　If c.Value <> "" Then
　　　For i = 1 To Len(c.Value)
　　　　If StrComp(StrConv(Mid(c.Value, i, 1), vbNarrow), "~") > 0 Then
　　　　　c.Offset(, iCol - 1).Value = Mid(c.Value, 1, i - 1)
　　　　　c.Offset(, iCol).Value = Mid(c.Value, i)
　　　　　Exit For
　　　　End If
　　　Next i
　　End If
　Next c
　Set rng = Nothing
　Application.ScreenUpdating = True
End Sub
　
p.s. zap35さんへ
この前から、そのコードは見ていましたが、

"^[Ａ-Ｚ,A-Z, ]+"

正規表現パターンに、「,（コンマ)」区切りはないはずです。コンマも一つの文字として見なされます。余計なお世話かもしれませんが。

この回答への補足

早速ありがとうございました

関数、マクロどちらもうまくいきました。
"ビートルズBeatles"のように日本語+アルファベットの場合はどうしたらいいですか

補足日時：2006/09/29 21:31

No.2 回答者： hirorin00 回答日時： 2006/09/29 21:02

はじめまして

いったんそのデータをタグ付き置換と正規表現を使えるテキストエディタなどにコピーします。
秀丸がおすすめです。

正規表現置換で
置換前：[a-z]\f[ア-ヲ]
置換後：\0＊\1
を実行します。

これで英字とカタカナの間に全角の「＊」が入ります。
これを保存してエクセルで再度読み込み、ターゲットの列を選択して、データ→区切り位置で「カンマやタブで…」にチェックを入れ次へ
区切り文字のその他にチェックを入れ「＊」を指定して完了をクリック

これでうまくいくはずです。

この回答へのお礼

早速ありがとうございます
秀丸もってないんで、今度やってみます

お礼日時：2006/09/29 21:47

No.1 回答者： zap35 回答日時： 2006/09/29 20:55

先頭から連続する「英文字（全角半角混在可）と空白」を右隣のセルに、残りを更に右隣のセルに格納するマクロです。

実際のシートに合わせて、マクロ中の
　RETSU = "A" '文字列の並んでいる列を指定する
の行は修正が必要です。（今はＡ列を指定しています）

Sub AZsplit()
Dim RE, strPattern, RETSU As String, Target As Range
Dim idxR As Long, mchItem
　Set RE = CreateObject("VBScript.RegExp")
　strPattern = "^[Ａ-Ｚ,A-Z, ]+"
　RETSU = "A" '文字列の並んでいる列を指定する
　For idxR = 1 To ActiveSheet.Cells(65536, RETSU).End(xlUp).Row
　　Set Target = Cells(idxR, RETSU)
　　With RE
　　　.Pattern = strPattern
　　　.IgnoreCase = True
　　　.Global = True
　　　Set mchItem = .Execute(Target.Value)
　　　If mchItem.Count > 0 Then
　　　　Target.Offset(0, 1) = mchItem(0).Value
　　　　Target.Offset(0, 2) = Right(Target.Value, _
　　　　　　Len(Target.Value) - mchItem(0).Length)
　　　End If
　　End With
　Next idxR
　Set RE = Nothing
End Sub

マクロはALT＋F11でVBE画面を開き、「VBAProjectエクスプローラのシート名右クリック」→「挿入」→「標準モジュール」で表示される画面にペーストして下さい。実行はALT＋F8を押して、マクロ名を選択します。

この回答へのお礼

早速ありがとうございました
ためしてみます

お礼日時：2006/09/29 21:37