質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.44%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Q&A

解決済

3回答

9597閲覧

特定のワードを含む行を抽出して別のワークシートに出力するマクロ

loreeeee

総合スコア40

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

0グッド

0クリップ

投稿2020/07/30 07:13

編集2020/07/30 07:16

前提・実現したいこと

エクセルで以下のような表がsheet1に記載されているとき
例えば商品ラベル列で「100」が含まれている商品ラベル行のみ抽出し、隣のシート(sheet2)へ書き出すマクロを描きたいのですが
やりかたを教えていただけますでしょうか?

商品ラベル値段(円)割引
a_100_果物3005
a_101_食器5005
a_120_植物1000
a_103_果物40010
b_100_食器50015

(このようなシートが下に1000行ほどつづきます。)

以下の部分までマクロを書いているのですが、抽出条件の部分の書き方がわかりません。

sub filter_and_write() sheet2.ClearContents '出力先のsheet2の値をすべてクリアしておく Dim rowsData As Long '行数カウント用の変数 rowsData = sheet1.Cells(Rows.Count, 1).End(xlUp).Row '最後の行数を取得 lael_code = Application.InputBox("抽出したい商品ラベルの番号を入力してください", "商品ラベルに含まれる番号を入力") 'ここで100と入力するようなメッセージボックスを作る Dim i As Long, k As Long k = 1 '出力先のセルの始点 For i = 2 To rowsData label_data = sheet1.Cells(i, 1).Value If ”label_dataに「label_code」が含まれている場合” Then sheet1.Range(sheet1.Cells(i, 1), sheet1.Cells(i, 3)).Copy sheet2.Cells(k, 1) '1行ごとにsheet2へコピーする k = k + 1 End If Next i  endsub

補足情報(FW/ツールのバージョンなど)

excel 2016

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答3

0

解決済みですがこういうことでしょうか・・。

VBA

1Sub filter_and_write() 2Dim rowsData As Long '行数カウント用の変数 3Dim label_code As string 4Dim mylabel As integer 5Dim mylabel_data As integer 6Dim i As Long, k As Long 7 8Sheet2.Range("A1").ClearContents '出力先のsheet2の値をすべてクリアしておく 9 10rowsData = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row '最後の行数を取得 11 12label_code = Application.InputBox("抽出したい商品ラベルの番号を入力してください", "商品ラベルに含まれる番号を入力") 'ここで100と入力するようなメッセージボックスを作る 13 14mylabel = Mid(label_code, 3, 3) 'Inputboxから番号のみを抽出 15 16k = 1 '出力先のセルの始点 17For i = 2 To rowsData 18 19 label_data = Sheet1.Cells(i, 1).Value 20 mylabel_data = Mid(label_data, 3, 3) '商品ラベルから番号のみを抽出 21 22 If mylabel = mylabel_data Then '比較 23 Sheet1.Range(Sheet1.Cells(i, 1), Sheet1.Cells(i, 3)).Copy Sheet2.Cells(k, 1) '1行ごとにsheet2へコピーする 24 k = k + 1 25 End If 26Next i 27End Sub

投稿2020/08/04 04:03

mako1972

総合スコア383

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

0

ベストアンサー

オートフィルターを使う方法も参考にどうぞ。

VBA

1Sub filter_and_write() 2 3Dim label_code As Long 4 5Sheet2.Cells.ClearContents 6 7label_code = Application.InputBox("抽出したい商品ラベルの番号を入力してください", "商品ラベルに含まれる番号を入力") 'ここで100と入力するようなメッセージボックスを作る 8 9With Range("a1").CurrentRegion 10 .AutoFilter field:=1, Criteria1:="*" & label_code & "*" 11 .Copy Sheet2.Range("a1") 12 .AutoFilter 13End With 14 15End Sub

投稿2020/07/30 07:59

編集2020/07/30 08:19
radames1000

総合スコア1925

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

loreeeee

2020/07/30 08:50

オートフィルターの使い方を教えていただきありがとうございます。上記マクロを実行したところ、 オブジェクト'AtoFilter'のメソッド'Range'が失敗しました とメッセージがでます。これはどういった要因なのでしょうか?
radames1000

2020/07/31 00:24 編集

'AtoFilter'と書かれてますが、「Autofilter」が正しいです。 正しく入力されていますか?コピペでいけると思うのですが・・・
radames1000

2020/08/04 02:36

まだ何か不具合が出ていますか?
loreeeee

2020/08/04 03:24

失礼しました。上記の修正で動作が確認できました。 回答いただきありがとうございました。
guest

0

VBA

1 If InStr(label_data, label_code) > 0 Then 'label_dataにlabel_codeが含まれている場合、見つかった先頭位置が返る(見つからないとゼロが返る)

ですね。

投稿2020/07/30 07:20

DreamTheater

総合スコア1095

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.44%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問