人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

【エクセルVBA】文字列を条件に沿って読み取ってペーストしたい


シートが2つあります「★」「場所」


★シートのA列にタイトル、K列に管理番号が下にずっと並んでいるのですが、この中の特定の条件(※1)を満たすものをコピーし、場所シートにペーストします。

画像を見ていただければわかりやすいです。


※1特定の条件
★シートK列内の管理番号は151214000AJKなど、先頭の9ケタが数字です。それが160108000以降のものを抽出し、その数字部分を降順にします。

それを、場所シートのD200から降順にしたK列の管理番号を貼付け、B200からK列に対応する★シートA列にあったタイトルを、すべてを下にペーストしていってほしいのです。
★シートK列の管理番号の読み取りは空白が20行続いた時点で終了します(D200から、B200から、20行続いた時点でという部分は、こちらで変えられるようにわかりやすく表示していただけると助かります)


なお、マクロ以外のご回答にはポイントはおつけできません。

お手数ですがよろしくお願いいたします。

1452305116
●拡大する

●質問者: naranara19
●カテゴリ:コンピュータ
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● a-kuma3
●150ポイント ベストアンサー

以下のコードを標準モジュールに貼り付けて、copy_item_data サブルーチンを実行してください。
アクティブなシートを対象にして、該当するデータを "場所" シートに複写します。

Const MAX_ROW = 10000
Const BASE_ITEM_NUMBER = 160108000

Function is_blank_cell(c)
 is_blank_cell = IsEmpty(c) Or c.Value = ""
End Function

Sub copy_xxx_data()
 Set dest_sheet = Sheets("場所")
 dest_r = 200
 r = 2
 blank_count = 0
 Do Until blank_count = 20  ' 空白行が20行続いたら打ち切り
 Set c = Cells(r, 11)  ' K 列
 If is_blank_cell(c) Then
 blank_count = blank_count + 1
 Else
 blank_count = 0
 item_number = Val(Left(c.Value, 9))
 Debug.Print Len(c.Value) & " " & item_number
 If item_number >= BASE_ITEM_NUMBER Then
 c.Copy dest_sheet.Cells(dest_r, 4)  ' 商品番号
 Cells(r, 1).Copy dest_sheet.Cells(dest_r, 2)  ' 商品名
 dest_r = dest_r + 1
 End If
 End If
 DoEvents
 r = r + 1
 If r > MAX_ROW Then  ' 念のため
 Exit Do
 End If
 Loop

  ' 商品番号の降順で並べ替え
 dest_sheet.Range(dest_sheet.Cells(200, 1), dest_sheet.Cells(dest_r, 4)).Sort Key1:=dest_sheet.Range("d200"), Order1:=xlDescending

End Sub

例によって、ビビッて最大処理行数を MAX_ROW で指定しています。
適宜、増やしてください。

「160108000以降」は、160108000 と等しいものも複写対象にしています。

商品番号の桁数のチェックはしてません。
もし、桁数として足りていないとか、先頭から9桁以内に数値以外の文字があった場合には、そこまでを対象にして数値として扱います。
なので、そのようなデータがあった場合には、複写の対象外となります。



「その数字部分を降順にします。」

とさせていただいておりまして、意味が伝わらなかったかもしれません。

完全に見落としてました m(_ _)m
先の回答のコードを修正しました。
サブルーチンの最後に、並べ替えのコードを追加しています。


naranara19さんのコメント
ありがとうございます。 管理番号が 160109103S.N 161212599★★★ 170228502 161018202MIC というものでやってみたら、 結果が上から、 161212599★★★ 160109103S.N 161018202MIC 170228502 となってしまったのです。 降順で、下記のようになってほしいのですが、私の指示と違いますでしょうか? 170228502 161212599★★★ 161018202MIC 160109103S.N

a-kuma3さんのコメント
「抽出した結果を並べ替える」という指示はなかったので、「場所」シートに抽出した結果は元のシートの並び順になります。 そう意味では、 >> となってしまったのです。 << という並び順にもならないはずなんですけど。

naranara19さんのコメント
「その数字部分を降順にします。」 とさせていただいておりまして、意味が伝わらなかったかもしれません。 すみませんが、そちらもお願いできますでしょうか? ポイントは加算させていただきますので、お手数ですが、どうかよろしくお願いいたします。

a-kuma3さんのコメント
>> 「その数字部分を降順にします。」 とさせていただいておりまして、意味が伝わらなかったかもしれません。 << 「指示がなかった」とか書いて、本当にすみません。 完全に見落としてました <tt>m(_ _)m</tt> 回答のコードを修正しました。 ポイントの加算とかはどうでも良いので、確認をしてみてください。

naranara19さんのコメント
ありがとうございます!約束どおり、ポイントは加算しますね。見落とし云々ではなく、普段からの感謝の印です!それと、ちと仕様を変えまして新たな質問をさせていただきますので、そちらもよろしければご協力いただけないでしょうか?この質問内容の変化版です。十分に流用できますので。
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ