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

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

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

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

Q&A

解決済

3回答

434閲覧

Sheet仕分け用のVBAが特定の箇所をスルーして処理完了する様になってしまいました

n_sk

総合スコア1

VBA

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

0グッド

0クリップ

投稿2022/10/05 10:00

前提

いつも商品の仕分けにVBAを使用していますが、
この度、一部の商品をスルーして仕分けしなくなりました。

「C社」の「商品×」(17行目の部分)だけ何度トライしても仕分けされなくなりました。
この問題が発生する前日までは処理出来ていました。

問題解決に向け、ご教示よろしくお願い致します。

イメージ説明

ちなみに画像には「商品△Sheet」もありますが、
こちらのSheetには問題がないためSheetの説明は省きます。
(VBAのコードにこちらのSheet名が出てくるため、画像へ表示しました。)

実現したいこと

「商品×」を「商品×Sheet」へ仕分けしたいです。

発生している問題・エラーメッセージ

問題となっている箇所をスルーして完成してしまうのでエラーメッセージは出ません。

該当のソースコード

VBA

1 2Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet 3Dim LastRow As Long 4Dim i As Long 5Dim J As Long 6Dim SearchWord As String 7 8 'Sheetセット 9 Set sh1 = Sheets("商品〇") 10 Set sh2 = Sheets("商品△") 11 Set sh3 = Sheets("商品×") 12 '検索キーワードセット 13 SearchWord = "商品×" 14 '最終行セット 15 LastRow = Cells(Rows.Count, 2).End(xlUp).Row 16 17 'Sheetを指定 18 sh1.Select 19 'データ先頭行セット 20 J = 6 21 '最終行までEndIfまでの内容を処理 22 For i = 6 To LastRow 23 '検索キーワードを含む場合 24 If InStr(Cells(i, 2), SearchWord) > 0 Then 25 '該当データを転記 26 sh1.Range(Cells(i, 1), Cells(i, 6)).Copy sh3.Cells(J, 1) 27 Rows(i).Delete 28 '次の行へ 29 J = J + 1 30 End If 31 Next i 32

試したこと

・「=if(B16=B17,"一致","不一致")」の判定
⇒"一致"でした。

・「=LEN("B16") 」と「=LEN("B17")」で文字数比較
⇒差が出ませんでした。

・17行目(「C社」の「×商品」)を切り取って、他の行へ挿入した上でのVBA実行
⇒どの行へ持っていっても「C社」の「商品×」行のみスルーして処理されました。

・処理できている行の「商品×」を、問題となっているセルへ貼付けVBA実行
⇒変わらず「C社」の「商品×」行のみスルーして処理されました。

・セル書式の確認
⇒他の行と同じく「標準」でした。

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

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

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

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

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

guest

回答3

0

ベストアンサー

VBA

1Rows(i).Delete 2'ここで「C社商品×」は16行目に繰り上がっている

しているからです。ループの途中で行削除しているため自動的に下のセルが繰り上がりを起こしているので、i=17の時には「C社商品×」は16行目にあります。なので一生参照されないんですね。この仕様ですと二行連続して×が入っている場所で毎回発生します。
愚直にi=i-1としても動きますが

VBA

1 For i = LastRow To 6 Step -1

に変えて下から順番に操作したほうがわかりやすくて安全です。
この際仕分け先のデータの順序が逆になってしまいますので、そちらが気になる場合はDelete(i)ではなくrows(i).clearContentsで空白化して後から消す方法になるかと思います。

※Excelはセルの自動補完をしてくれるので問題ありませんが、基本的にループ中に要素数が変化する場合は「後ろから前」になるようにしてください。これがメモリ操作だった場合「存在しない要素」を参照しようとして大変なことになりますので・・・
(例の場合途中で三行消えているがLastRowは変化しないので存在しない元26-28行目を参照することになる)

投稿2022/10/06 06:22

編集2022/10/06 06:26
pig_vba

総合スコア807

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

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

sikimori

2022/10/06 11:36 編集

途中に空行が存在しないことが前提ですが、 「空白行まで繰り返す」でもいいかもですね! i = 6 Do Until sh1.Cells(i, 1).Value = "" ~~~処理~~~ i = i + 1 Loop
n_sk

2022/10/07 07:57

pig_vba様、ありがとうございます! ご教示頂いた内容でコードを修正したところ、希望通りの動作となりました。 また、逆順での対応方法の補足や、「後ろから前」などのアドバイスのお心遣い、大変助かります。 ご指摘頂いた点、学ばせて頂き精進したいと思います。
n_sk

2022/10/07 07:59

sikimori様、別案、ありがとうございました。 今後も別の機会でマクロの作成は続けていきますので、その際に参考とさせて頂きます。
guest

0

うまく行かない原因はpig_vbaさんの回答どおりだと思います。

対策としては、pig_vbaさんからも提案がありますが、それとは別の案を。

検索キーワードでフィルターをかけて、抽出されたデータをコピーして、その行を削除するという方法です。

vba

1 Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet 2 Dim LastRow As Long 3 Dim SearchWord As String 4 5 'Sheetセット 6 Set sh1 = Sheets("商品〇") 7 Set sh2 = Sheets("商品△") 8 Set sh3 = Sheets("商品×") 9 '検索キーワードセット 10 SearchWord = "商品×" 11 '最終行セット 12 LastRow = Cells(Rows.Count, 2).End(xlUp).Row 13 '検索キーワードでフィルターをかける 14 sh1.Range("A5:F" & LastRow).AutoFilter Field:=2, Criteria1:=SearchWord 15 With sh1.Range("A6:F" & LastRow) 16 'フィルター結果が1行より多ければ(見出し行を含むので) 17 If sh1.Range("A5:A" & LastRow).SpecialCells(xlCellTypeVisible).Count > 1 Then 18 .Copy sh3.Range("A6") 'フィルター結果を転記 19 .EntireRow.Delete 20 End If 21 .AutoFilter 'フィルター解除 22 End With

投稿2022/10/06 15:40

hatena19

総合スコア33620

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

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

n_sk

2022/10/07 08:02

ご回答頂きありがとうございました! こちらの案も、別の機会で大いに役立ちそうなので参考にさせて頂きます。
guest

0

マクロ実行時にアクティブになってるシートはなんでしょうか?

LastRow = Cells(Rows.Count, 2).End(xlUp).Row

上記にシートの指定がないので
sh1ではなくアクティブシートの最終行を取得しています。

sh1.Selectの後ろに移すか、
LastRow = sh1.Cells(Rows.Count, 2).End(xlUp).Row

としてみてください。

投稿2022/10/05 12:02

sikimori

総合スコア13

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

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

n_sk

2022/10/06 11:06

早速ご回答頂きありがとうございます! 頂いた内容で修正してみたのですが、状況変わらずでした。
sikimori

2022/10/06 11:43 編集

原因としてはpig_vba様の回答の通りかと思います! それとは別に(これはただのおせっかいですが) cellsやrowsに対してはシートを指定した方がいいと思います。 Deleteで別のシートのデータが消えたりすると困ったことになるので!
n_sk

2022/10/07 08:01

解決まで見守って頂きありがとうございます! ご指摘頂いた点、ごもっともで、早速今回のマクロに組み込ませて頂きました。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.50%

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

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

質問する

関連した質問