Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


2524 / 13646 ツリー ←次へ | 前へ→

【67486】特定のセルに入っている文字を別々のセルに分けたい 初心者 10/12/9(木) 7:56 発言[未読]
【67489】Re:特定のセルに入っている文字を別々のセ... Jaka 10/12/9(木) 9:28 発言[未読]
【67497】Re:特定のセルに入っている文字を別々のセ... [名前なし] 10/12/9(木) 14:46 お礼[未読]

【67486】特定のセルに入っている文字を別々のセル...
発言  初心者  - 10/12/9(木) 7:56 -

引用なし
パスワード
   はじめまして。
まだまだ初心者です。
仕事で手作業で毎回毎回やっているのですが集計が多くて簡略化したいのですが良い方法があれば教えて下さい。

エクセルのB4のセルからH4まで不特定の文字列が入ります。(空白のときもあり)

例えばB4のセルには、
りんご、いちご、みかん、とまと  などの文字が入ります。
これをB4からB8のセルにそれぞれ分けたいのです。

B4 りんご
B5 いちご
B6 とまと
B7 
B8

文字と文字の間は「、」で分ける事ができるのですが、自分自身の目で見て分けるのは簡単なのですが簡略化出来る方法は無いでしょうか?

同様にC4に入っている文字をC4〜C8に細分化したい。
それぞれB4〜H4までは複数のリストが入っている場合、1つしかない場合、空白の場合とあります。
B4に入っている内容を分解してB4からなのでこれが無理なら、
B5〜B9まで分けた後で4の行を削除しても大丈夫です。(または値をクリアー)

この作業を1日300件近く処理するので結構時間が掛かり大変なので、簡単に出来る方法があれば教えて下さい。

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

【67489】Re:特定のセルに入っている文字を別々の...
発言  Jaka  - 10/12/9(木) 9:28 -

引用なし
パスワード
   りんご、いちご、みかん、とまと
の入っているセルを別ブック(作業用)にコピペ。

A1に貼り付けたとして、
データ → 区切り位置 → 次へ → その他にチェックして、「、」を記入。
OKで、各セルに振り分けられます。
それらをコピーして、形式を選択して貼り付けで、行列を入れ替えて貼り付け。
空白の場合は、適当に対応してください。(処理の仕方がわからなかったので)

【67497】Re:特定のセルに入っている文字を別々の...
お礼  [名前なし]  - 10/12/9(木) 14:46 -

引用なし
パスワード
   ご返信ありがとうございます。
VB以前に初歩的なところで引っかかっている事が解りました。
申し訳ありませんでした。

アドバイスを参考にVB作成して見ました。

SUB TEST()

Range("B4:H4").Select
  Selection.Copy
  ActiveWindow.SmallScroll Down:=39
  Range("B70").Select
  Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
  Application.CutCopyMode = False
  Selection.TextToColumns Destination:=Range("B70"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
    :="、", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
    TrailingMinusNumbers:=True
  Range("B70:F76").Select
  Selection.Copy
  ActiveWindow.SmallScroll Down:=-48
  Range("B4").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True
  Range("B4").Select
End Sub

これだと目的のことが出来るようになりました。
ありがとうございました。
もう少し簡略化しながら試してみます。

2524 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free