リストから抽出

Question

前回こちらで質問させていただいたのですが、説明不足だったので再度質問として補足を加えました。回答をいただいた方には申し訳ありませんが再度確認をお願い出来ませんでしょうか？

リストには番号、産地、品物、数量といった感じで横に並んでいます。

番号　　　　産地　　　　品物　　　　　　数量　
0001　　　　北海道　　　豚桃　　　　　　3
0002　　　　大阪　　　　 サンマ黒　　　 5
0003　　　　鹿児島      　　　豚　TB黒F    　 2
0004　　　　長崎　　　　 牛黒F          　　　 　9
0005　　　　大分         　　　　牛無色         　　　 　1

問題になるのが品物の項目で様々な色や品目があり、
同じ豚でもタイプが違って豚、豚　TBというようにスペースが空いてたりします。
色も同様に黒、黒Fといった感じで他にも無色、例外ものがあったります。
これらを考慮しつつ下記の図のように抽出させてその後の作業に続くマクロを作りたいと思っています。

番号　　　　産地　　　　品物　　　　　　色　　　　　　数量　
0001　　　　北海道　　　豚　　　　　　　桃　　　　　　　3
0002　　　　大阪　　　　 サンマ　　　 　黒　　　　　　　5
0003　　　　鹿児島      　　　豚　TB　　  　 黒F 　　　　　　2
0004　　　　長崎　　　　 　牛　　　      　　  黒F　　　　　　 9
0005　　　　大分        　　　　 牛　　       　　　  無色　　　　　　1

条件に豚、豚　TB、サンマ、牛を指定してその後に続く文字を色に持ってこさせるか
もしくは他の方法で効率のいいやり方があればマクロで教えて頂けませんでしょうか？

急ぎではありませんので宜しくお願い致します。

n-jun · Accepted Answer

＃３です。

”色＋アルファベット１文字”若しくは”＊色”とあった場合が例外として、
それを除くと一番右の値を移動させる。

例）
豚桃⇒豚　桃
豚黒Ａ⇒豚　黒Ａ
豚水色⇒豚　水色
豚黄緑色⇒豚黄　緑色（不対応。。。）

Ｄ列への列挿入から開始。

Sub　try()
　Dim　r　As　Range
　Dim　st　As　String

'　Ｄ列に新しい列を挿入
　Range("D:D").Insert
　'　Ｄ１の値を”色”とする
　Range("D1").Value　=　"色"

'　Ｃ２～Ｃの最終行までを調べる
　For　Each　r　In　Range("C2",　Cells(Rows.Count,　3).End(xlUp))

'　Ｃ列の値の一番右をチョイスする
　　　　　st　=　Right$(r.Value,　1)

'　もしチョイスした値を小文字にしたらA～Zだった場合か、
　　　　　'　”色”となっていた場合
　　　　　If　StrConv(st,　vbNarrow)　Like　"[A-Z]"　Or　st　=　"色"　Then

'　チョイスする値を右から２文字にする
　　　　　　　　st　=　Right$(r.Value,　2)
　　　　　End　If

'　Ｄ列にチョイスした値を入れる
　　　　　r.Offset(,　1).Value　=　st

'　Ｃ列からチョイスした文字を消す
　　　　　'　Ｃ列の文字数を左からチョイスの文字数を引いた文字数
　　　　　r.Value　=　Left$(r.Value,　Len(r.Value)　-　Len(st))

Next
End　Sub

みたいな感じですけど。

hige_082 · Answer

質問の表のパターンではうまく行きますが・・・・
他のパターンが出てくると無理だと思う

元のリスト：Sheet1
書き出し先：Sheet2

Sub test()
Dim i As Long
Dim iLen As Integer
Dim jLen As Integer
Dim lAsc As Long
Dim sTxt As String
With Worksheets("sheet1")
For i = 2 To .Cells(Rows.Count, 3).End(xlUp).Row
iLen = Len(.Cells(i, 3).Value)
For jLen = iLen To 2 Step -1
sTxt = Mid(.Cells(i, 3).Value, jLen, 1)
lAsc = Asc(sTxt)
If lAsc < 65 Then
If sTxt <> "色" Then
Worksheets("sheet2").Cells(i, 1).Value = .Cells(i, 1).Value
Worksheets("sheet2").Cells(i, 2).Value = .Cells(i, 2).Value
Worksheets("sheet2").Cells(i, 3).Value = Left(.Cells(i, 3).Value, jLen - 1)
Worksheets("sheet2").Cells(i, 4).Value = Right(.Cells(i, 3).Value, iLen - jLen + 1)
Worksheets("sheet2").Cells(i, 5).Value = .Cells(i, 4).Value
Exit For
End If
End If
Next jLen
Next i
End With
End Sub

参考まで

n-jun · Answer

＃２です。

＞追加で新しい色やタイプがどんどん入ってきます。
出力する側で何らかの対応をしないと、
モグラたたき状態になるのでは？
⇒受け側で対策を講じても都度変更しなければいけなくなる。

と思いますよ。

結局”品物”と”色”が混在している中で、
＜どんなパターンがあるのか？＞と言うのが最重要ポイントでしょう。
”右から1文字”と言っても”黒Ｆ”や”無色”は該当しませんし、
なら”その２つだけしか例外はない？”
と言うわけでもないのでしょう。

n-jun · Answer

別に”品物”のリストを作成出来れば可能かと思いますが。

番号　　　　産地　　　　品物　　　　　　数量　
0001　　　　北海道　　　豚桃　　　　　　3
0002　　　　大阪　　　　 サンマ黒　　　 5
0003　　　　鹿児島 　　　豚　TB黒F 　 2
0004　　　　長崎　　　　 牛黒F 　　　 　9
0005　　　　大分 　　　　牛無色 　　　 　1

”品物”の右に”色”の列を追加して値をコピー

番号　　　　産地　　　　品物　　　　　　　色　　　　数量　
0001　　　　北海道　　　豚桃　　　　　　豚桃　　　　3
0002　　　　大阪　　　　 サンマ黒　　　サンマ黒　　 5
0003　　　　鹿児島 　　　豚　TB黒F 　　豚　TB黒F　 2
0004　　　　長崎　　　　 牛黒F 　　　　 牛黒F　　　9
0005　　　　大分 　　　　牛無色 　　　  牛無色　　　1

あとは

品物
　豚　TB
　豚
　サンマ
　牛

と言うリストを用いて”色”の列の値の”品物名"を置換で""に変えてしまうとか？
⇒リスト行数によっては時間はかかるかも。。。

tom11 · Answer

番号　　　　産地　　　　品物　　　　　　数量　
0001　　　　北海道　　　豚/桃　　　　　　3
0002　　　　大阪　　　　サンマ/黒　　　 5
0003　　　　鹿児島 　　 豚/TB黒F 　      2
0004　　　　長崎　　　　牛/黒F 　　　 　9
0005　　　　大分 　　　 牛/無色 　　　 　1

上記のような整理の仕方が出来ませんか？可能であれば
分割文字を/にして、容易に品目と色に分割できます。

まず、整理方法を検討した方が良いのではないですか。

リストから抽出

＃３です。

この回答への補足

質問の表のパターンではうまく行きますが・・・・

この回答への補足

＃２です。

別に”品物”のリストを作成出来れば可能かと思いますが。

番号 産地 品物 数量

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

番号　　　　産地　　　　品物　　　　　　数量　