VBA セルの削除

質問

開いているブック全てに対して、セルを削除するマクロを組んだのですが、うまく動作しません。

1. ブックのsheet1にてセルB2～B100の中で、値があるセルを特定
値の入ったセルがあれば、その値と同じ名前のシートが存在する
例) B2:値 1-A、シート名: 1-A
B3:値 2-A、シート名: 2-A
...
2. 特定した値と同じ名前のシートをアクティブにする
3. そのシートにて「セルA1がブランクでない かつ セルB1の値がゼロ」と条件をかける
4. trueであれば、sheet1にて特定したセルへ戻る
5. 特定したセルとその右隣のセルを削除(上シフト)
6. 1.～5.を、sheet1のセルB2以降、値がブランクになるまで繰り返す

次の通り構文を作成、エラーなく実行できるのですが、結果は5.までしか処理されず、他のブックに対しても処理が走っていません。
格納した変数に問題がありそうなのですが、解決できず困っています。

Sub test()
Dim WBK As Workbook

For Each WBK In Workbooks
If WBK.Name <> ThisWorkbook.Name Then
WBK.Activate
For i = 2 To 100
touroku = WBK.Worksheets("sheet1").Cells(i, 2).Value
If WBK.Worksheets("sheet1").Cells(i, 2).Value <> "" Then
WBK.Worksheets(touroku).Activate
If ActiveSheet.Cells(1, 1) <> "" And ActiveSheet.Cells(2, 1).Value = 0 Then
WBK.Worksheets("sheet1").Cells(i, 2).Resize(1, 2).Delete
End If
End If
Next i
WBK.Save
End If
Next WBK
End Sub

まだVBA初めて1ヶ月ほどで、基礎が理解できてきた程度なのですが、急ぎ完成させたいマクロなのでお力を貸してください。
よろしくお願いいたします。

回答No.1

keithin · ベストアンサー

定石なので覚えて下さい。「下から上に向けて」処理します。

sub macro1()
　dim w as workbook
　dim r as long
　dim s as string

　for each w in workbooks
　if not w.name like "Personal*.*" then
　　for r = w.worksheets("Sheet1").range("B65536").end(xlup).row to 2 step -1
　　　s = w.worksheets("Sheet1").cells(r, "B").value
　　　if w.worksheets(s).range("A1") <> "" and w.worksheets(s).range("B1") = 0 then
　　　　w.worksheets("Sheet1").cells(r, "A").entirerow.delete shift:=xlshiftup
　　　end if
　　next r
　　w.save
　end if
　next
end sub

お礼

早速のご回答ありがとうございます。
定石覚えるようにします。
お陰様で、参考にしながら3つほどデバッグして完成できました。
以外がデバッグした部分なのですが、理解し切れていませんので教えていただければと思います。

デバッグ箇所
1. if not w.name like "Personal*.*" then
⇒w.name <> thisworkbook.name then
エラーとなったのですが、原因は開いている他のブックにマクロが組まれていたからでしょうか？

2. for r = w.worksheets("Sheet1")
⇒for = w.worksheets(2)
実際のシート名は"登録"なのですが、インデックスが有効範囲にないとなりました。定数ではないからでしょうか？
シートの位置が左から2つで固定のため、位置で指定しました。

3. cells(r, "A").entirerow.delete shift:=xlshiftup
⇒cells(r, 2).resize(1,2).delete
書いていただいた構文ですと、行が削除されましま。
特定したセルとその右隣のセルだけを削除したかったため、このように変えたのですが間違いないでしょうな？

よろしくお願いします。

回答No.2

keithin

まず１について。
ちょいと先の回答のマクロに細工を追加します

変更前：
　if not w.name like "Personal*.*" then
変更後：
　if not strconv(w.name, vblowercase) like "personal*.*" then

さて。
元のご相談：
＞開いているブック全てに対して、セルを削除するマクロを組んだ

あなたは何も考えずに「全部のブックを対象にやりたい」とヤリタイ事を思いつきましたが、ホントにそれでいいのですか？と指摘をしているのが回答のマクロです。

試しに新しい練習用マクロ

sub renshu1()
　dim w as workbook
　for each w in workbooks
　　msgbox w.name
　next
end sub

を実際に「あなたのエクセルで」実行させてください。
いま開いているブック名が次々表示されるのでそれらをよく確認して、「開いているすべてのブックを対象に」作業してホントに問題ないのか、それ以外の余計なブックは一つたりとも開いていないか、もう一回よくあなたのエクセルの実際の様子をキチンと確認して理解してください。

そのうえで、処理したいブックと「そうでないけど開いてるブック」がもしも確かにあったなら、回答のマクロを参考にして「処理しなくていいブックはスキップする」ようにキチンとマクロを修正してください。自力で。
もしも間違いなく確かに「すべてのブックを無条件にやっちゃっていい」なら、if … end ifの処理は不要です。

２番目。
ご質問の２番目は、こちらも状況としては「全部のブックをやっちゃってはダメだ」という事を示しているように見受けられます。
でもまぁ、あなたが修正したマクロで上手く動いたなら、それで十分です。ここは別にわざわざ判らない事に手を染める必要はありません。

３番目。
セルを２個だけ削除すると、他の列のセルは「残ったまま」になります。
通常そういった「段違い」になるのを避けるために行削除しますが、別にセル２個削除するのでアナタが問題ないなら、それでいいです。

お礼

お返事遅くなり申し訳ありません。
ご回答いただきありがとうございました。

前提の説明不足でしたが、このマクロはPersonal.xlsに設定はしていませんでした。
マクロを設定したブックを開いておき、セルを削除したいブックを開いておくことを前提としていました。
ですので、ご回答いただきました　if not w.name like "Personal*.*" thenや、
　if not strconv(w.name, vblowercase) like "personal*.*" thenで作動しなかったのだと理解しました。

実際にPersonal.xlsにマクロを設定、セルを削除したいブックにてマクロを実行すると、いただきましたコーディングで作動しました。

変更前、後ともにPersonalの部分がしっかり理解できていませんので、もう少し理解を深めます。

どうもありがとうございました。大変助かりました。