エクセル 任意の日本語でセルの内容を分割する方法

質問

エクセル　任意の日本語でセルの内容を分割する方法

　　Ａ　　　　　　　　　　　　　　　　　　　　　Ｂ

１　店舗：○○店（全角スペース）取引先：△△　　１０００円

２　店舗：□□店（全角スペース）取引先：☆☆　　２０００円

３　店舗：○○店（全角スペース）取引先：◆◆　　３０００円

　　・　　　　　　　　　　　　　　　　　　　　　・
　　・　　　　　　　　　　　　　　　　　　　　　・
　　・　　　　　　　　　　　　　　　　　　　　　・

　　Ｃ　　　　Ｄ
１　○○店 　　△△

２　□□店 　　☆☆

３　○○店 　　◆◆

　　・　　　　・
　　・　　　　・
　　・　　　　・

いつも拝見させて頂いております。

上記の用なＡ列の内容を、ＣとＤに分割して貼り付ける関数またはマクロのボタンを考えているのですが、

全くのお手上げ状態で大変困っております。

どなたかヒントでも構いませんので、教えていただけないでしょうか？

よろしくお願い致します。

使用環境：Windows7x64 Office 2007

回答No.2

molly1978 · ベストアンサー

C
=MID(A1, FIND("店舗：",A1,1)+3,FIND("　",A1,1)-FIND("店舗：",A1,1)-3)

D
=RIGHT(A1,LEN(A1)-FIND("取引先：",A1,1)-3)

少し複雑ですが、店舗名、取引先が２文字でなくても対応できます。

お礼

ご回答有り難うございます！

上記の関数で全く問題ありませんでした！本当に有り難うございます。

恐縮ですが、新しく今回の続きをご質問させて頂いておりますので、お力をお貸し頂けると幸いです。

よろしくお願いします。

回答No.4

Wendy02

いろいろ試してみましたが、文章の内容から、三つの条件を推測し、それが存在するとなかなか難しくなります。(なお、全角のスペースは確実にあとは思っていません）

1. 数字のついた店名や取引先がないとは限らない。

2. >１　店舗：○○店（全角スペース）取引先：△△　　１０００円
取引先名と金額の間にスペースがあるとは限らない。

3. 金額は半角とは限らない。

そういうことを考慮すると、以下のようなコードになりました。

コントロールツール・ボタンで、ダブルクリックして、シートモジュールを開け、そこにコードを貼り付けます。

Private Sub CommandButton1_Click()
　Dim ar(1) As Variant
　Dim buf As String
　Dim c As Variant
　With CreateObject("VBScript.RegExp")
　　Application.ScreenUpdating = False
　　For Each c In Range("A1", Cells(Rows.Count, 1).End(xlUp))
　　　If c.Value Like "店舗*" Then
　　　　buf = StrConv(c.Value, vbNarrow)
　　　　ar(0) = PickUpText(buf, "店舗.([^\s]+)\s*.+")
　　　End If
　　　If buf Like "*取引先*" Then
　　　　buf = Trim(Mid(buf, Len(ar(0)) + 4))
　　　　ar(1) = PickUpText(buf, "取引先.([^\s]+)")
　　　End If
　　　c.Offset(, 2).Resize(, 2).Value = ar　'貼り付け
　　Next
　　Application.ScreenUpdating = True
　End With
End Sub
Private Function PickUpText(ByVal strTxt As String, ByVal mPattern As String)
Dim Matches As Object
With CreateObject("VBScript.RegExp")
　.Pattern = mPattern
　.Global = False
　Set Matches = .Execute(strTxt)
　 PickUpText = Matches(0).SubMatches(0)
End With
End Function

お礼

あらゆる事態を想定して頂き、またご丁寧にご教授頂き有り難うございます！

データの入力に規則性がない場合に是非利用させて頂きます。

素晴らしすぎる意外に言葉が見つかりません。本当に本当に有り難うございます。

恐縮ですが、新しく今回の続きをご質問させて頂いておりますので、お力をお貸し頂けると幸いです。

よろしくお願いします。

回答No.3

noname#169205

Ｃに=MID(A1,4,FIND("　",A1)-3)
Ｄに=MID(A1,FIND("取引先：",A1)+4,LEN(A1)-(7+LEN(C1)))

お礼

ご回答有り難うございます！

今回はmolly1978様にお答え頂いた内容をご使用させて頂きました。

今回の続きをご質問させて頂いておりますので、お力を貸して頂けると助かります。

よろしくお願いします。

回答No.1

未 定（@v4330）

Cには
=MID(A1,FIND(" ",A1,1)+1,3)
Dには
=MID(A1,FIND("：",A1,1)+1,2)
どうです

お礼

度々申し訳御座いません。

店舗と取引先は必ず２文字ではない場合はどうすればよろしいでしょうか？

補足

早速のご回答有り難うございます。

ご指摘ただいた内容を入れてみましたところ、

D（=MID(A1,FIND("：",A1,1)+1,2)）の方にCに入れたい内容が、

C（=MID(A1,FIND(" ",A1,1)+1,3)）の方は#VALUE! エラーが表示されました。

Ｃの部分は=MID(A1,FIND("：",A1,1)+1,2)でいけます！

有り難うございます！

少しご指摘いただいた関数を変えて試してみたいと思います！