リストから抽出

質問

前回こちらで質問させていただいたのですが、説明不足だったので再度質問として補足を加えました。回答をいただいた方には申し訳ありませんが再度確認をお願い出来ませんでしょうか？

リストには番号、産地、品物、数量といった感じで横に並んでいます。

番号　　　　産地　　　　品物　　　　　　数量　
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、サンマ、牛を指定してその後に続く文字を色に持ってこさせるか
もしくは他の方法で効率のいいやり方があればマクロで教えて頂けませんでしょうか？

急ぎではありませんので宜しくお願い致します。

回答No.4

n-jun · ベストアンサー

＃３です。

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

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

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

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

みたいな感じですけど。

お礼

ほとんどのパターンにうまく行きました。

一部のパターンにはうまくいかなかったようです。(それでも嬉しいです)
カメ無とかカタカナが含まれている色には判別できないみたいです。
私の説明不足で申し訳ありません・・・
有難うございました。

補足

If　StrConv(st,　vbNarrow)　Like　"[A-Z]"　Or　st　=　"色"　Then
こちらの"[A-Z]"　を複数指定させることは可能でしょうか？
例えば、A-Zのときは２文字、無のときは３文字とか・・・
こちらで複数指定でやってみましたのですがうまく行きませんでした。

回答No.5

hige_082

質問の表のパターンではうまく行きますが・・・・
他のパターンが出てくると無理だと思う

元のリスト：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

参考まで

お礼

回答有難うございます。

＃４と同じように上手く行きました。
これらを参考にしてカメ無が含まれているパターンも判別出来るようにしてみたいと思います。
有難うございました。

補足

＃4と＃5を参考にさせていただいたところ、
やっと完成しました。
本当に助かりました。有難うございました！

回答No.3

n-jun

＃２です。

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

と思いますよ。

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

お礼

回答有難うございます。

例外が出てきたとしても色の文字数のパターンとしては1～3文字までです。
品物で「豚　TB」の「名前　タイプ」のようにスペースが空いてたりするので「豚　TB黒」の時に「TB黒」を色と見なして抽出されてしまう場合があるかなと思いまして・・・

回答No.2

n-jun

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

番号　　　　産地　　　　品物　　　　　　数量　
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
　豚
　サンマ
　牛

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

お礼

回答有難うございます。

リストは行数はゆうに15000を超え、色や品物はこれ以外にも沢山あり
追加で新しい色やタイプがどんどん入ってきます。
時間かかりそうな気がします・・・

こちらは品物と数量の間にセルを追加してSUBSTITUTEとRIGHTを使用して右側から
1文字を抽出させて、フィルタで抽出し切れていない色を検索しつつちまちま修正しています。これをマクロに組み込めればいいのですが、初心者で品物と色の判別をどうプログラミングしていけばいいのかわからないのです。

回答No.1

tom11

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

上記のような整理の仕方が出来ませんか？可能であれば
分割文字を/にして、容易に品目と色に分割できます。

まず、整理方法を検討した方が良いのではないですか。

お礼

回答有難うございます。

データが受信されてから始める作業でエクセルに詳しくない方にやらせたいと思っており、整理してからマクロにかける作業を考えていましたが難しいと言われたのです。
上記の場合、豚　TB黒Fは豚　TB/黒Fになります。TBはタイプのようなものです。
やはり厳しいでしょうか？