エクセルでの変換について ２

質問

エクセルのデータで同じセルに、
例えば、「(株)山田建設ヤマダケンセツ山田太郎」というように、(会社名)(半角カタカナ)(氏名)のデータが入力されている１列のデータがある場合、これを、それぞれ切り分けて、３列のデータに変換することは可能でしょうか？それぞれのデータの文字数は一定ではありません。
間にある半角のカタカナデータをうまく利用すれば、切り分けられるように思うのですが、どうでしょうか？

回答No.2

tresbien · ベストアンサー

RIO d さんのコード番号を使いました。
作業域が多くなってしまいましたが。

A1に最初のデータがあるとしてB1に次の式を入力22こコピーします（22は仮にそうしただけです）X列までです。
=IF(LEN($A1)<COLUMN()-1,"*",MID($A1,COLUMN()-1,1))
さらに
Y1　　{=MATCH(1,(CODE(B1:X1)>=165)*(CODE(B1:X1)<=224),0)}
Z1 　 {=SUM((CODE(B1:X1)>=165)*(CODE(B1:X1)<=224))}
下の2式は配列数式で入力、つまりCtrl+Shift+Enter　で確定します。

(株)山田建設ヤマダケンセツ山田太郎　(株)山田建設ヤマダケンセツ山田太郎　8 8

こんな感じになります。
Y1の8はヤが8番目に出たことを示し、Z1の8はカタカナが8個含まれることを示しています。
後はこの数値を使ってLEFT関数等で文字を抜き出してください。

お礼

どうもありがとうございます。
これでできました。

回答No.4

Wendy02

切り分けの時は、正規表現のほうが楽ですね。
半角カタカナとそうでないものとの切り分けをします。

以下は、ツール－マクロ－Visual Basic Editor
挿入－標準モジュールで貼り付けて
後は、切り出す範囲をマウスで選択して、

マクロ－マクロ－「SeparateString」をクリックで、
A列に元があれば、B列からD列に出力します。

Sub SeparateStrings()
　Dim objRE As Object
　Dim c As Range, i As Long
　Dim myRng As Range
　Dim HanKana As String
　Dim Matches As Variant
　Dim Match As Variant
　HanKana = Chr(&HA1) & "-" & Chr(&HDF) '半かな
　Set myRng = Selection
　If TypeName(myRng) <> "Range" Then Exit Sub
　Set objRE = CreateObject("VBScript.RegExp")
　With objRE
　　.Pattern = "([^" & HanKana & "]+)" & "([" & HanKana & "]+)" & _
　　"([^" & HanKana & "]+)"
　　.Global = True
　　Application.ScreenUpdating = False
　　For Each c In myRng
　　　If .test(c.Value) Then
　　　　Set Matches = .Execute(c.Value)
　　　　For Each Match In Matches
　　　　　c.Offset(, 1).Value = .Replace(Match, "$1")
　　　　　c.Offset(, 2).Value = .Replace(Match, "$2")
　　　　　c.Offset(, 3).Value = .Replace(Match, "$3")
　　　　Next Match
　　　End If
　　Next c
　End With
　With myRng.Cells(1)
　'オートフィット
　For i = 1 To 3
　　 .Offset(, i).EntireColumn.AutoFit
　Next
　Application.ScreenUpdating = True
　End With
　Set objRE = Nothing: Set myRng = Nothing
End Sub

お礼

どうもありがとうございます。
なんとかできました。

回答No.3

BLUEPIXY

とりあえず、ユーザー定義関数を作ってみました。
'----------------------------------------------
'半角カナの判定
Private Function isKanaChar(c) As Boolean
isKanaChar = &HDF >= Asc(c) And Asc(c) >= &HA1
End Function
'カタカナ（半角：&HA1～&HDF）部分の文字列を取り出す
Public Function getKana(str As String) As String
Dim ret As String
Dim i, ch
ret = ""
For i = 1 To Len(str)
ch = Mid(str, i, 1)
If isKanaChar(ch) Then ret = ret + ch
Next
getKana = ret
End Function
'最初に見つかったカナ文字部分を取り出す
Public Function getKanaPart(str As String) As String
Dim ret As String
Dim i, ch, flag
ret = "": flag = False
For i = 1 To Len(str)
ch = Mid(str, i, 1)
If isKanaChar(ch) Then
flag = True
ret = ret + ch
Else
If flag Then Exit For
End If
Next
getKanaPart = ret
End Function
'最初のカナ文字の位置を返す
Public Function findKanaFirst(str As String)
Dim i, ret
ret = "": ret = 0
For i = 1 To Len(str)
If isKanaChar(Mid(str, i, 1)) Then
ret = i
Exit For
End If
Next
findKanaFirst = ret
End Function
'最後のカナ文字の位置を返す
Public Function findKanaLast(str As String)
Dim i, ret
ret = "": ret = 0
For i = Len(str) To 1 Step -1
If isKanaChar(Mid(str, i, 1)) Then
ret = i
Exit For
End If
Next
findKanaLast = ret
End Function
'-----------------------------------------------
上記のfindKanaFirst,findKanaLastを使って
A1からB1,C1,D1に切り出します。
B1
=LEFT(A1,findKanaFirst(A1)-1)
C1
=MID(A1,findKanaFirst(A1),findKanaLast(A1)-findKanaFirst(A1)+1)
または、
=getKana(A1)
または、
=getKanaPart(A1)
D1
=RIGHT(A1,LEN(A1)-findKanaLast(A1))

回答No.1

rio_d

こんにちは。

ワークシート関数だけでは難しいと思います。

楽に分割したいのであれば、csv形式にしてから加工する方法が考えられます。

(1)社名等が入力されている列だけをコピーし、新しいブックのA列に貼り付ける
(2)新しいブックを、名前をつけて保存する
　保存の際、ファイルの種類を「CSV(カンマ区切り)」にして下さい
(3)保存したCSVファイルをメモ帳で開く
(4)会社名と半角カナ、半角カナと氏名の間にひたすらカンマ(，)を打ちまくる
(5)打ちまくったら保存する
(6)CSVファイルをエクセルで開く
(7)分割されているので、そのセル範囲をコピーし元のブックに貼り付ける
(8)できあがり

セル上で編集するよりは楽かと思います。

マクロを使うという手もありますが…。ヒントのみで勘弁してください。
（作ってさしあげる元気が無いです）

【マクロのヒント】
(1)文字列の頭から、一文字ずつ判定してゆく
(2)165<Asc(文字)<224なら半角カナです。