エクセル セル内の文字列を空白から空白まで抽出したい。

一つのセルに入っている文字列を複数のセルに分割したいのですが良い方法が見つかりません。

具体的には
「商品名　単価　数量　金額」が一つのセルに入っているのですが、これをそれぞれ「商品名」「単価」「数量」「金額」というように別のセルに分けたいのです。
条件は次です。
・文字列の区切りは空白(スペース)。
・商品名や金額などそれぞれの文字列の長さは決まっていません。
・商品名には名称の中に空白が使われている場合があります、その数も決まっていません。

以上です。いろいろ関数を使ってやってみたのですが、どうもうまくいきません。
どなたか良い方法がありますでしょうか、よろしくお願いいたします。

No.8 ベストアンサー 回答者： ham_kamo 回答日時： 2006/11/10 16:36

No.2です。

分割されなくなって、単にＢ列にコピーとなってしまったのは、ヘッダ部分だけでなく、データ行も全てそうなってしまったのでしょうか？

ヘッダ行かどうか判断するのに「単価」「数量」「金額」であるべきところが「数値であるか」という処理を追加したのですが、データ行のデータが単純に数字でなくて@100とか1000個などとなっていると、ヘッダと見なされてしまいます。

とりあえず、その処理を抜いてみました。ヘッダ部分に空白が３つ以上あると他のデータ行と同様に分割され、空白が２つ以下ならそのままＢ列に転記されてしまいますが、それでＯＫならこれでいけるかも。

Sub SplitItems()
　　Dim r As Range
　　Dim c As Variant
　　Dim i As Integer
　　With Worksheets("Sheet1")
　　　　For Each r In .Range("A1", .Range("A1").End(xlDown))
　　　　　　c = Split(r, " ")
　　　　　　If UBound(c) < 3 Then
　　　　　　　　r.Offset(0, 1).Value = r.Value
　　　　　　Else
　　　　　　　　r.Offset(0, 1).Value = ""
　　　　　　　　For i = 0 To UBound(c) - 3
　　　　　　　　　　r.Offset(0, 1).Value = Trim(r.Offset(0, 1).Value & " " & c(i))
　　　　　　　　Next
　　　　　　　　r.Offset(0, 2).Value = c(UBound(c) - 2)
　　　　　　　　r.Offset(0, 3).Value = c(UBound(c) - 1)
　　　　　　　　r.Offset(0, 4).Value = c(UBound(c))
　　　　　　End If
　　　　Next
　　End With
End Sub

この回答へのお礼

出来ました！！
ありがとうございます。
期待したとおりの結果が完全に出ました。

返答に時間がかかって申し訳ありませんでした。貴重なお時間をありがとうございました。

ちなみに
「分割されなくなって、単にＢ列にコピーとなってしまったのは、ヘッダ部分だけでなく、データ行も全てそうなってしまったのでしょうか？」
への回答は「その通りです。」です。

お礼日時：2006/11/13 15:35

No.11 回答者： judas_2006 回答日時： 2006/11/13 20:43

allezさん

「穴があったら入りたい」です。こちらこそ、どんくさいマクロをわざわざご確認頂き、ありがとうございました。
それにしても、ham_kamoさんのご回答は美しいですね。最初拝見したときは難しそうだったので、内容を全く確認していませんでした。改めて拝見すると、(私が無知のため知らなかった)関数(Split)や配列の取り扱いが、まるで教科書のようですね。(自慢にならないどころか、allezさんからはお叱りを受けそうですが)私はVBAの本とかに触ったことすらなく、大変勉強になりました。

この回答へのお礼

とんでもありません、あれだけの時間を割いて回答していただいただけで、感謝の気持ちでいっぱいです。
たしかにham_kamoさんのマクロは美しいですね、私は早く中身が理解できるようにがんばります。

お礼日時：2006/11/14 12:38

No.10 回答者： judas_2006 回答日時： 2006/11/12 04:53

穴があったら入りたいNo.5&7&9です。

> ・商品名には名称の中に空白が使われている場合があります、その数も決まっていません。
No.9で使用可能なスペース数は1個なので、この条件を満たしていませんでした。ワーク列を増やし、直前のスペース位置を前列から受け取りながら次々に検出していくようにすれば、数式を大きく複雑化せずに実行可能とも考えたのですが、どんどんマクロに近付いてしまうのでいっそのことマクロで作り直そうと思い、試してみました。これまた、どんくさい内容ですが、ご確認頂けませんか。
・スペースは、区切り用には半角のみ使用可能、商品名には半角・全角とも使用可能。
・字下げはタブではなくスペースで入れたのですが、確認画面では他の箇所も含め全て削除されてしまいました。また長い行も_で改行しなかったので、非常に見にくいと思います。「教えて！goo」初心者ということで、ご容赦頂ければ幸いです。

Sub データ抽出()
Dim Space_Su As Integer, Space_Ichi(20) As Integer, Space_Max As Integer, Data_Number As Integer
Dim MojiRetsu_Su As Integer, KugiriSu_1 As Integer, KugiriSu_2 As Integer
Dim Tani_Su As Integer, Tani_Ichi As Integer, Shikibetsu_Su As Integer, i As Integer, j As Integer, k As Integer
Dim ShutokuData As String, MojiRetsu As String, Moji As String
Dim Tani(10) As String, Shiyo_Tani As String, Shikibetsu As String

Columns("B:Z").ClearContents
KugiriSu_1 = 1 '必須スペースの前半数、スペース合計=前半数+名称箇所使用数+後半数
KugiriSu_2 = 3 '必須スペースの後半数
Tani_Su = 3 '使用単位数
Tani(1) = "本" '例
Tani(2) = "箱" '例
Tani(3) = "ダース" '例
Shikibetsu = "商" '項目名の行を先頭文字で識別
Space_Max = 20 '使用される可能性のあるスペース最大数
Data_Number = 1
ShutokuData = Range("A1")
Do While ShutokuData <> Empty
MojiRetsu_Su = Len(ShutokuData)
Space_Su = 0
For i = 0 To Space_Max
Space_Ichi(i) = 0
Next i
For i = 1 To MojiRetsu_Su 'スペース位置の検出
Moji = Mid(ShutokuData, i, 1)
For j = 1 To Tani_Su
If Moji = Left(Tani(j), 1) Then
Tani_Ichi = i
Shiyo_Tani = Tani(j)
End If
Next j
If Moji = " " Then
Space_Su = Space_Su + 1
Space_Ichi(Space_Su) = i
If Space_Su > Space_Max Then
MsgBox "スペース数オーバー！", vbExclamation, "注意"
Exit Sub
End If
End If
Next i
If Space_Su < KugiriSu_1 + KugiriSu_2 Then
Space_Su = 0
End If
j = 1
For i = 0 To Space_Su - 1 '項目の切り離し
Select Case Left(ShutokuData, 1)
Case Shikibetsu
Range("A1").Cells(Data_Number, j + 1) = Mid(ShutokuData, Space_Ichi(i) + 1, Space_Ichi(i + 1) - Space_Ichi(i) - 1)
Case Else
Select Case i
Case 0 To KugiriSu_1 - 1, Space_Su - KugiriSu_2 To Space_Su
Select Case Tani_Ichi '「単位+数量」の切り離し
Case Space_Ichi(i) + 1 To Space_Ichi(i + 1) - 1
Range("A1").Cells(Data_Number, j + 1) = Shiyo_Tani
j = j + 1
Range("A1").Cells(Data_Number, j + 1) = Mid(ShutokuData, Tani_Ichi + Len(Shiyo_Tani), Space_Ichi(i + 1) - Space_Ichi(i) - Len(Shiyo_Tani) - 1)
Case Else
Range("A1").Cells(Data_Number, j + 1) = Mid(ShutokuData, Space_Ichi(i) + 1, Space_Ichi(i + 1) - Space_Ichi(i) - 1)
End Select
Case Else '名称項目(商品名)
k = Space_Su - KugiriSu_2
Range("A1").Cells(Data_Number, j + 1) = Mid(ShutokuData, Space_Ichi(i) + 1, Space_Ichi(k + 1) - Space_Ichi(i) - 1)
i = k
End Select
End Select
j = j + 1
Next i
Range("A1").Cells(Data_Number, j + 1) = Right(ShutokuData, MojiRetsu_Su - Space_Ichi(Space_Su))
Data_Number = Data_Number + 1
ShutokuData = Range("A1").Cells(Data_Number, 1)
Loop
Range("A1").Cells(Data_Number + 1, 1).Select

End Sub

この回答へのお礼

回答ありがとうございます。
こちらをやってみたのですが、エラーは起きないのですが、一部分割がうまくいかないところがありました。データを見てもそれがどうして分割されないかはよくわかりませんでした。
3110000067 メロンソーダガロン本1,281 1.80 7,705
これは「分割されず」
3110000077 液化ガスK 本9,941 1.80 3,493
これは「6分割」
1400003091 カフェプラス50ml×50 袋8 1.30 231
これは「5分割」でした。

というわけで、
結果的に　No.８(ham_kamo)さんの回答を参考にさせていただきました。

返答が遅くなって申し訳ありませんが　judas_2006さんの貴重なお時間いただきありがとうございました。

お礼日時：2006/11/13 15:51

No.9 回答者： judas_2006 回答日時： 2006/11/11 06:30

No.5&7です。

allezさん、実際のデータを示して頂き、どうもありがとうございます。正直、かなり驚きましたが、可能な範囲で対応させて頂きました。ご確認をお願いします。

【前提】
・区切りスペースは全て半角！
・商品名に含まれるスペースは最大1個まで　←　IFの入れ子最大数の制約からこうなりました
・ヘッダーに含まれるスペースは2個まで
・実データ5行目の"商品コード 商品名 単位 単価 数量 棚卸金額"において、区切りには半角スペースが使用されるものとし、実データの一部をIF判定に使用
【ワーク列・単位】
・IFの入れ子制約等から途中経過を保存するために、I及びJ列をワーク列として使用しました。　←　ルール違反かもしれませんが、必要に応じて非表示等のご対応をお願いできればと思います
・実データで使用される単位(3個まで)を、L1、M1、N1に入力下さい。

【数式】
A列 = 元データ列
B1 = IF(ISERROR(FIND(" ",A1,FIND(" ",A1,FIND(" ",A1,1)+1)+1)),A1,LEFT(A1,FIND(" ",A1,1)-1))
C1 = IF(B1=A1,"",IF(OR(NOT(ISERROR(FIND("商",I1))),ISERROR(FIND(" ",I1,FIND(" ",I1,FIND(" ",I1,FIND(" ",I1,1)+1)+1)+1))),LEFT(I1,FIND(" ",I1,1)-1),LEFT(I1,FIND(" ",I1,FIND(" ",I1,1)+1)-1)))
D1 = IF(AND(ISERROR(FIND(LEFT($L$1,1),J1)),ISERROR(FIND(LEFT($M$1,1),J1)),ISERROR(FIND(LEFT($N$1,1),J1))),J1,IF(ISERROR(FIND(LEFT($L$1,1),J1)),IF(ISERROR(FIND(LEFT($M$1,1),J1)),$N$1,$M$1),$L$1))
E1 = IF(B1=A1,"",IF(D1="単位",MID(I1,LEN(C1&D1)+3,FIND(" ",I1,LEN(C1&D1)+3)-LEN(C1&D1)-3),MID(I1,LEN(C1&D1)+2,FIND(" ",I1,LEN(C1&D1)+2)-LEN(C1&D1)-2)))
F1 = IF(B1=A1,"",IF(D1="単位",MID(I1,LEN(C1&D1&E1)+4,FIND(" ",I1,LEN(C1&D1&E1)+4)-LEN(C1&D1&E1)-4),MID(I1,LEN(C1&D1&E1)+3,FIND(" ",I1,LEN(C1&D1&E1)+3)-LEN(C1&D1&E1)-3)))
G1 = IF(B1=A1,"",RIGHT(I1,LEN(I1)-LEN(C1&D1&E1&F1)-3))
H列　=　空列
I1 = IF(B1=A1,"",RIGHT(A1,LEN(A1)-FIND(" ",A1,1)))
J1 = IF(B1=A1,"",MID(I1,LEN(C1)+2,FIND(" ",I1,LEN(C1)+2)-LEN(C1)-2))
K列 = 空列
L1 = "本" ←　例
M1 = "箱" ←　例
N1 = "ケース" ←　例

【補足】
・上記は、実際のデータを以下のように区分するものとして作成しました。万一異なっていた場合、allezさんにてご対応頂ければ幸いですが、もし分からない箇所があれば、改めてご質問下さい。
商品コード：3060000791
商品名 ： シーバスリーガル 12年700ml
単位 ： 本　←　(*)
単価 ： 1,240
数量 ： 0.20
棚卸金額 ： 5,448
　(*)「本1,240」は単位と単価がくっ付いていたものと判断し、敢て分割しました。L1～N1の入力はこの作業に用います。
・従来のallezさんのご説明から、商品名の中には" "(スペース列)、""(ブランク)があるものと想像し、それに対応すべく数式を作成していました。実際のデータを見て、エラーも止むを得ないと感じました。
・こういう作業は、やはりマクロの出番ですね。入れ子の制約といったこともないし、データ列のスペース数をカウントすれば比較的容易に実行可能と思います。

No.7 回答者： judas_2006 回答日時： 2006/11/10 00:51

No.5です。

マクロが動くのであれば、そちらの方向で検討されることをお勧めしますが、シート上でも処理可能なのかどうか知りたく思い、ご指摘の箇所への対策を考えてみました。No.5の数式のうち、B1のみ以下のように変更してお試し頂けませんか。（本当にどんくさくなってしまいました）

B1 = IF(TYPE(VALUE(LEFT(A1,1)))=1,"",IF(A1=TRIM(A1),LEFT(A1,FIND("　",A1,1)-1),IF(ISERROR(FIND("　",A1,(FIND("　",A1,FIND("　",A1,FIND("　",A1,1)+1)+1)+1))),LEFT(A1,FIND("　",A1,1)-1),LEFT(A1,LEN(A1)-LEN(TRIM(A1))-1))))

いくつか仮定させて頂きました。
・区切りスペースは全て全角。
・商品名は、文字列、スペース(複数個も可)、ブランクのいずれかで、先頭の1文字目は数字ではない。
・商品名がブランクの場合に限り、区切りスペースは2個(先頭が単価)もしく3個とする。他の場合は、区切りスペースは3個のみ。
・単価には0を含む数値が入っている。
・数量、金額にはブランク及びスペースは用いられていない。
・（ヘッダーには対応していません。たぶんエラー表示となります）

うまく動くといいのですが、もしうまく動かず、なおかつシート上での処理にもご関心がおありなら、動かない「商品名　単価　数量　金額」の具体例を挙げて頂けると有り難く思います(商品名等はダミーで)。

この回答へのお礼

ありがとうございます。
こちらもやってみましたがうまくいきません。
B列で区切られるのは、ヘッダー行だけになってしまい。
それ以外の文字列だとB列はブランクになりC列から実質的に分割を行うようになってしまいました。

以下が具体例です。7行目からが取得するデータです。
（※実際のデータには、他に商品コードと単位というものがあります）

2 /
店舗: 416 ○○
棚卸区分棚卸区分名
2006年10月棚卸表印刷日2006/11/08
商品コード商品名単位単価数量棚卸金額
1 ドリンク
3040001161 ニコライウォッカ黒 720ml 本27 1.70 9,065
3050000441 モルツ中瓶500ml 本32 45.00 2,540
3050000651 モルツ生樽20L 本360 2.50 10,900
3060000791 シーバスリーガル 12年700ml 本1,240 0.20 5,448

お礼日時：2006/11/10 16:27

No.6 回答者： ham_kamo 回答日時： 2006/11/09 19:07

No.2です。

マクロが動いてよかったです。
ヘッダー行があるとのことなので、「空白で区切られた項目が３個以下」または、「最後３つの項目のうち１つでも数字でない場合」に「そのままＢ列に転記する」という処理を追加してみました。
これでほとんどのケースはカバーできると思いますが、いかがでしょうか。

Sub SplitItems()
　　Dim r As Range
　　Dim c As Variant
　　Dim i
　　With Worksheets("Sheet1")
　　　　For Each r In .Range("A1", .Range("A1").End(xlDown))
　　　　　　c = Split(r, " ")
　　　　　　If UBound(c) < 3 Then
　　　　　　　　r.Offset(0, 1).Value = r.Value
　　　　　　ElseIf IsNumeric(c(UBound(c) - 2)) And IsNumeric(c(UBound(c) - 1)) And IsNumeric(c(UBound(c))) Then
　　　　　　　　r.Offset(0, 1).Value = ""
　　　　　　　　For i = 0 To UBound(c) - 3
　　　　　　　　r.Offset(0, 1).Value = r.Offset(0, 1).Value & " " & c(i)
　　　　　　　　Next
　　　　　　　　r.Offset(0, 2).Value = c(UBound(c) - 2)
　　　　　　　　r.Offset(0, 3).Value = c(UBound(c) - 1)
　　　　　　　　r.Offset(0, 4).Value = c(UBound(c))
　　　　　　Else
　　　　　　　　r.Offset(0, 1).Value = r.Value
　　　　　　End If
　　　　Next
　　End With
End Sub

この回答へのお礼

回答ありがとうございます。
早速やってみたところ、今度はエラーはなくなりましたが、
肝心の分割がなくなってしまい、単純にA列をB列にコピーしただけになってしまいました。
なおるでしょうか。

お礼日時：2006/11/10 16:07

No.5 回答者： judas_2006 回答日時： 2006/11/09 13:37

皆さんのようにスマートな方法ではありませんが、どんくさい方法なら分かりやすいかと思い、参考までにコメントさせて頂きます。

前提は皆さんとほぼ同様です。
A1「商品名　単価　数量　金額」、B1「商品名」、C1「単価」、D1「数量」、E1「金額」とします。
スペースは全て全角だとします。
商品名はブランクでも構いませんが、区切りのスペースは必ず3個あるとします。

B1 = IF(A1=TRIM(A1),LEFT(A1,FIND("　",A1,1)-1),LEFT(A1,LEN(A1)-LEN(TRIM(A1))-1))
C1 = MID(A1,LEN(B1)+2,FIND("　",A1,LEN(B1)+2)-LEN(B1)-2)
D1 = MID(A1,LEN(B1&C1)+3,FIND("　",A1,LEN(B1&C1)+3)-LEN(B1&C1)-3)
E1 = RIGHT(A1,LEN(A1)-LEN(B1&C1&D1)-3)

蛇足ですが、「商品名　単価　数量　金額」はたぶん別のファイルで供給されるのだと思います。もしそうなら、ファイルを開く作業を含めマクロにした方がラクチンのようにも思われます。

この回答へのお礼

やってみたら、きれいに出来ました。
ただ、商品名にもブランクが入っているので、Ｅ列に必ずしも金額が入らないのが難しいところです。

お礼日時：2006/11/09 17:57

No.4 回答者： maron--5 回答日時： 2006/11/08 22:31

◆A1のデータを、B1=商品名　C1=単価　D1=数量　E1=金額　にするものとします

>文字列の区切りは空白(スペース)。
◆スペースは、「半角スペース」とします

B1=REPLACE(A1,FIND("*",SUBSTITUTE(A1," ","*",SUMPRODUCT(N(MID(A1,ROW($1:$50),1)=" "))-2)),LEN(A1),)

E1=--REPLACE(A1,1,FIND("*",SUBSTITUTE(A1," ","*",SUMPRODUCT(N(MID(A1,ROW($1:$50),1)=" ")))),)

D1=--SUBSTITUTE(REPLACE(A1,1,FIND("*",SUBSTITUTE(A1," ","*",SUMPRODUCT(N(MID(A1,ROW($1:$50),1)=" "))-1)),)," "&E1,)

C1=--SUBSTITUTE(REPLACE(A1,1,FIND("*",SUBSTITUTE(A1," ","*",SUMPRODUCT(N(MID(A1,ROW($1:$50),1)=" "))-2)),)," "&D1&" "&E1,)

No.3 回答者： NNAQ 回答日時： 2006/11/08 22:12

A1に「商品名　単価　数量　金額」とあるのを

B1「商品名」、C1「単価」、D1「数量」、E1「金額」に分けるとします。
スペースは全て全角だとします。

B1=LEFT(A1,FIND("Я",SUBSTITUTE(A1,"　","Я",LEN(A1)-LEN(SUBSTITUTE(A1,"　",""))-2))-1)
C1=MID(A1,LEN(B1)+1,FIND("　",REPLACE(A1,1,LEN(B1)+1,"")))*1
D1=MID(A1,LEN(B1&C1)+2,FIND("　",REPLACE(A1,1,LEN(B1&C1)+2,"")))*1
E1=MID(A1,LEN(B1&C1&D1)+3,LEN(A1))*1

これでいけるかも。

No.2 回答者： ham_kamo 回答日時： 2006/11/08 21:48

「全部で項目は４つ」

「空白が入るのは商品名だけ」
という条件で、マクロを書いてみました。
Alt+F11でVBAの画面を立ち上げて、以下のマクロを貼り付けて実行してみてください。その際、
・マクロの中で最初に"Sheet1"と書いてある部分は、実際のシート名に変更してください。
・マクロの中で"A1"となっているのは、実際に分割したいデータが入っているセルの先頭の番地に変えてください。
・そのセルの右４つにデータを分割して放り込むので、他のデータが入っている場合は４列分右に挿入しておいてください。

これでお望み通りの結果が得られるといいのですが。

Sub SplitItems()
　　Dim r As Range
　　Dim c As Variant
　　Dim i
　　With Worksheets("Sheet1")
　　　　For Each r In .Range("A1", .Range("A1").End(xlDown))
　　　　　　c = Split(r, " ")
　　　　　　r.Offset(0, 1).Value = ""
　　　　　　For i = 0 To UBound(c) - 3
　　　　　　　　r.Offset(0, 1).Value = r.Offset(0, 1).Value & " " & c(i)
　　　　　　Next
　　　　　　r.Offset(0, 2).Value = c(UBound(c) - 2)
　　　　　　r.Offset(0, 3).Value = c(UBound(c) - 1)
　　　　　　r.Offset(0, 4).Value = c(UBound(c))
　　　　Next
　　End With
End Sub

この回答へのお礼

早速マクロを書いていただき、ありがとうございます。
マクロはあまり詳しくないですが、マクロがお勧めということなので、挑戦してみました。
見事にきれいに出来てびっくりです。
ただ、最初の条件には書き漏らしたのですが、元の文字列は基本は質問どおりなのですが、たまにヘッダー部分が5行くらい入ってるのです。
そこはブランクが一切無い行もあったりするので、
r.Offset(0, 2).Value = c(UBound(c) - 2)のところでいつもエラーでとまってしまいます。
回避の良い方法はあるでしょうか？

お礼日時：2006/11/09 18:06