エクセルVBAで条件にあった言葉を隣のセルに入れたい

質問

すみません。教えてください。
エクセル2003で、１つのセルにまとまっている文字列をC列、D列、E列、F列に分割して文字列を入れたいのです。
毎月、500名程度処理します。

下記のような形で入れて行きたいです。
B列の文字を分割したいです。
B列は途中で空白が入っている場合があります。
B列の事業部名、部名などの文字数はバラバラです。
A列の社員番号は桁数はバラバラですが、空白はありません。

　　　　A列　　　　　B列　　　　　　　　　　　　　　C列　　　　
1行目　1234567　○○事業部△△△部正社員販管　　　○○事業部
2行目　978　　　×××事業部□□部アルバイト原価　×××事業部

　D列　　　　E列　　　　　F列
△△△部　　正社員　　　　販管
□□部　　　アルバイト　　原価

最初はIF関数を使って、C列にIf(B1="○○事業部△△△部正社員販管",
"○○事業部",if(B1="×××事業部□□部アルバイト原価","×××事業部"・・・・・）と入れていったのですが、50パターンくらいあり、数式が入りきりませんでした・・・・。
よろしくお願い致します。

回答No.3

ka_na_de · ベストアンサー

エクセルのメニュー操作での一例を紹介します。

C列に　○○事業部△△△部正社員販管　といった文字が入っているとして、
１）C列を選択
２）上記メニューで「編集」→「置換」
　　「検索する文字列」を「部」
　　「置換後の文字列」を「部　」とする。
　　注）部の後ろにスペースが入っています。
　　　「すべて置換」→「OK」
３）C列を再度選択
４）上部メニューで「データ」→「区切り位置」
　　「カンマやタブなどの・・・」にチャックして「次へ」
　　「スペース」にチェックして「次へ」→「完了」
５）C列に事業部
　　D列に部署名
　　E列にそれ以下が分割されると思います。

お礼

ありがとうございます！！！！
すごいっ！出来ました！！！！

てっきりもうＶＢＡを使わないと出来ないと思っていたのですが、
キレイにわかれました！！！

マクロに記録させたので、自動で出来るようになりました。
ありがとうございました！

回答No.2

dokinhime

標準モジュールに貼り付けて
マクロの分割を選んで実行して下さい。

空白については　
「○○事業部　　△△△部　　正社員　　販管」
というように　それぞれの単語はつながっているとみなして
空白削除しています。
ですので　「○　○事業部」　の場合○と○の間の空白は削除されません。
また、社員の区分については、正社員とアルバイトを区別するようにしています。他の区分がある場合は、追加して下さい。

Sub 分割()
Dim MyRow As Long
Dim MyText As String
Dim MyPosC As Integer
Dim MyPosD As Integer
Dim MyPosE As Integer
Dim MyLen As Byte '社員区分の文字数

MyRow = 1
Do Until Cells(MyRow, 1) = ""
MyPosC = 0
MyPosD = 0
MyPosE = 0
MyLen = 0
MyText = Cells(MyRow, 2)

'C列　事業部-----------------------------------
MyPosC = InStr(MyText, "事業部")
If MyPosC > 0 Then
Cells(MyRow, 3) = Trim(Left(MyText, MyPosC + 2))
MyPosC = MyPosC + 3
End If

'D列　部-----------------------------------
MyPosD = InStr(MyPosC, MyText, "部")
If MyPosD > 0 Then
Cells(MyRow, 4) = Trim(Mid(MyText, MyPosC, MyPosD - MyPosC + 1))
myposcd = MyPosD + 2
End If

'E列　正社員 or アルバイト-----------------------------------
If InStr(MyPosC, MyText, "正社員") Then
Cells(MyRow, 5) = "正社員"
MyLen = 3
ElseIf InStr(MyPosC, MyText, "アルバイト") Then
Cells(MyRow, 5) = "アルバイト"
MyLen = 5
End If

'F列　-----------------------------------
Cells(MyRow, 6) = Trim(Mid(MyText, MyPosD + 1 + MyLen, Len(MyText) - MyPosD - MyLen))
MyRow = MyRow + 1
Loop
End Sub

お礼

ka_na_de様から教えていただいたやり方で、できました。
長い関数を教えていただいたのに、今回は申し訳ありません。
次回また何か分割の処理をするときに使わせていただきます。
ありがとうございました！

補足

ありがとうございます！
コピペしてやってみたのですが、
Ｄ列部のところがエラーしてしまいます。
列がずれているのかなー？と思っていろいろ試してみたのですが、
どうしてもＤ列部が「プロージャーの呼び出し、または因数が不正です。」というエラーが出てしまいます。

これはＢ列に何も入っていないセルがあったりするからだったりするのでしょうか？

回答No.1

m_boy

データの分割
Sub test()
Dim v
v = Split([A1].Value, "-")
[B1].Resize(, UBound(v) + 1).Value = v
End Sub

あと、
(桁数が固定なら)
こんなのも

Sub test2()
[A1].Parse "[xxxx] [xxx] [xxx] [xxx] [xxxxx]", [B1]
End Sub

補足

すみません。
Sub test()
Dim v
v = Split([A1].Value, "-")
[B1].Resize(, UBound(v) + 1).Value = v
End Sub

を標準モジュールにコピペしてみたのですが、何も起こりませんでした・・・・。
コピペだけでは駄目なんでしょうか・・・