VBA100本ノック 14本目：社外秘シート削除

公開日：2020-11-02　最終更新日：2021-01-13

VBA100本ノック 14本目：社外秘シート削除

シートの値貼り付けと社外秘シートを削除する問題です。
客先へブックを送付する場合をそうていした処理になります。

ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータはご自身でご用意ください。
いろいろなパターン（シート名・数式・状態）で確かめてみてください。

出題

#VBA100本ノック 14本目
客先へ送付するブックを作成します。
シート名に「社外秘」の文字が含まれるシートを削除してください。
他のシートは計算式を消して値だけにしてください。
※シート間参照の数式あり。
※条件付き書式・入力規則は未使用。
※対象はアクティブブックで構いません。

明日出す解答のVBAを今書いています。
どうしようかと悩んだ処理のいくつかが、集まった回答に見当たらないようでした。
VBAの技術的な話と気遣いの話。
（見落としていたらゴメンナサイ）
どちらも出題としては必須事項ではないのですが…
なので、参考としてその処理を入れます。

VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。

他の人の回答および解説を見て、書いたVBAを見直してみましょう。

頂いた回答

出題ツイートの引用ツイートでの回答

解説

#VBA100本ノック 14本目解答
考え方中心に、
要点
・客先へ送付
・社外秘シートの削除
・値貼り付け
注意点
・シート削除の前に値貼り付けする
・シート削除できない場合がある
後者の件
・表示シートが無くなる
・xlSheetVeryHidden
最後に、非表示シートのまま内容確認しなくて良いのでしょうか?


  
    
      Sub VBA100_14_01()

　　Const cns社外秘 = "*社外秘*"

　　Dim wb As Workbook

　　Set wb = ActiveWorkbook

　　

　　'社外秘の全シート削除の可否

　　If Not canDelete(wb, cns社外秘) Then

　　　　MsgBox "送付すべきシートを再確認してください。"

　　　　Exit Sub

　　End If

　　

　　With Application

　　　　.ScreenUpdating = False

　　　　.DisplayAlerts = False

　　　　'手動計算で入力したままの可能性があるので一旦再計算

　　　　.Calculation = xlCalculationAutomatic

　　　　.Calculation = xlCalculationManual

　　End With

　　

　　'計算式はワークシートのみ

　　Call pasteValues(wb, cns社外秘)

　　

　　'削除は全種類のシートが対象

　　Call delSheets(wb, cns社外秘)

　　

　　'全シートを表示し、A1を選択しつつ先頭シートへ

　　Call AllSheetsGotoA1(wb)

　　

　　With Application

　　　　.Calculation = xlCalculationAutomatic

　　　　.DisplayAlerts = True

　　　　.ScreenUpdating = True

　　End With

      End Sub

VBAのコメントを読めばやらんとしていることは理解していただけると思います。
もっと単純なコードにすべきだとも思いましたが、VBAコードよりも考え方の方が重要だと思ったのであえて記載しました。
（もちろん考え方はいろいろあります）
VBA全文は記事補足に掲載しました。

補足

上記VBAの全コードです。


  
    
      Sub VBA100_14_01()

　　Const cns社外秘 = "*社外秘*"

　　Dim wb As Workbook

　　Set wb = ActiveWorkbook

　　

　　'社外秘の全シート削除の可否

　　If Not canDelete(wb, cns社外秘) Then

　　　　MsgBox "送付すべきシートを再確認してください。"

　　　　Exit Sub

　　End If

　　

　　With Application

　　　　.ScreenUpdating = False

　　　　.DisplayAlerts = False

　　　　'手動計算で入力したままの可能性があるので一旦再計算

　　　　.Calculation = xlCalculationAutomatic

　　　　.Calculation = xlCalculationManual

　　End With

　　

　　'計算式はワークシートのみ

　　Call pasteValues(wb, cns社外秘)

　　

　　'削除は全種類のシートが対象

　　Call delSheets(wb, cns社外秘)

　　

　　'全シートを表示し、A1を選択しつつ先頭シートへ

　　Call AllSheetsGotoA1(wb)

　　

　　With Application

　　　　.Calculation = xlCalculationAutomatic

　　　　.DisplayAlerts = True

　　　　.ScreenUpdating = True

　　End With

End Sub


'社外秘シート以外で表示されているシートの存在確認

Function canDelete(ByVal wb As Workbook, ByVal aStr As String) As Boolean

　　Dim sht As Object

　　canDelete = True

　　For Each sht In wb.Sheets

　　　　If sht.Visible And Not sht.Name Like aStr Then

　　　　　　Exit Function

　　　　End If

　　Next

　　canDelete = False

End Function


'社外秘シート以外の全ワークシート値貼り付け

Sub pasteValues(ByVal wb As Workbook, ByVal aStr As String)

　　Dim ws As Worksheet

　　For Each ws In wb.Worksheets

　　　　If Not ws.Name Like aStr Then

　　　　　　'これが一番無難だと思います。

　　　　　　ws.Cells.Copy

　　　　　　ws.Cells.PasteSpecial Paste:=xlPasteValues

　　　　End If

　　Next

　　Application.CutCopyMode = False

End Sub


'社外秘シートを削除する

Sub delSheets(ByVal wb As Workbook, ByVal aStr As String)

　　Dim sht As Object

　　For Each sht In wb.Sheets

　　　　If sht.Name Like aStr Then

　　　　　　'xlSheetVeryHidden対策

　　　　　　sht.Visible = xlSheetVisible

　　　　　　sht.Delete

　　　　End If

　　Next

End Sub


'全シートを表示し、A1を選択しつつ先頭シートへ

'いったん全てのシートを表示します。

'非表示のまま客先へ変なものを送付してしまわないように！

Sub AllSheetsGotoA1(ByVal wb As Workbook)

　　Dim i As Long

　　For i = wb.Worksheets.Count To 1 Step -1

　　　　wb.Worksheets(i).Visible = xlSheetVisible

　　　　Application.Goto wb.Worksheets(i).Range("A1"), True

　　Next

End Sub

上記VBAでは、全シートのループが何度も動きますが、これはほんの一瞬なので特に気にする必要は無いと思います。
それより値貼り付けの方がはるかに時間がかかりますし、検討課題が多いと思います。

値貼り付けはUsedRange.Valueでも構いませんが、使用範囲が大きいとかえって時間もかかりますし、
極端に範囲が大きい場合は、メモリ不足で停止してしまいます。


  
    
      ws.UsedRange.Value = ws.UsedRange.Value

また、以下のように計算式のあるセル範囲だけを対象にする方法もあります。


  
    
      On Error Resume Next

Dim rng As Range

For Each rng In ws.Cells.SpecialCells(xlCellTypeFormulas).Areas

      　　rng.Value = rng.Value

Next

SheetsコレクションとWorksheetsコレクションとの違いは理解しておいてください。
Sheetsにはグラフシートも含まれますが、Worksheetsには含まれません。
滅多に使用しないとは思いますが、万一にでもグラフシートが社外秘だったなんてことがあったら困ります。

そして、お客様先に送付する前には人間が目で最終確認すべきだと思います。
「社外秘」の文字が間違っていたり、「社外持ち出し禁止」と書かれていたり・・・
考えたらきりがありません。
もちろん、出来る限りVBAで対処しておくことに越したことはありませんが、限界もあるでしょう。
少なくとも、何らかのルールは必要ですし、最後は人間が確認すべきです。

そして、そもそもの話としては、
最初から、最終的に客先送付するブックとしてこれらを意識して作成しておくべきだと思います。
例えば、ブック間リンクなどはしないようにしておくべきでしょう。

そして、最後は気遣いを忘れないようにしたいですね。

サイト内関連ページ

第40回．セルのコピー・カット&ペースト（Copy,Cut,Paste）

・セルをコピー（複写）する場合・セルを切り取る（移動する）場合・セル範囲のコピーについて・別のシートにコピーする場合・アクティブシート以外へのコピー・セルのコピーについてのサイト内参考ページ

第41回．セルのコピー&値の貼り付け（PasteSpecial）

・PasteSpecialメソッド・値の貼り付け・いろいろなコピーのVBAの書き方・PasteSpecialの使用例・最後に

第42回．セルをコピーするとは

・セルをコピーするとは・上記方法ではコピーできないプロパティ・.Valueのセル範囲間のコピー・.Value以外の場合は、セル範囲をセル範囲にコピーは出来ません・コピー方法の使い分け・セルのコピー（Copyメソッド）実行時の注意点・最後に

第66回．シートのコピー・移動・削除（Copy,Move,Delete）

・シートのコピー・移動・シートの削除・シートのコピー・移動・削除の関連記事

第69回．シートの非表示（Visible）

ユーザーが操作・閲覧する必要のないシートは非表示にする事で使い易いExcelブックにします。マスタ情報やマクロでのみ使用するデータが入っているシート等、通常は使用者が変更することがなく、見る必要もないのであれば、シート保護をするより非表示にしてしまった方が、ユーザーにとっては使いやすいブックとなります。

同じテーマ「VBA100本ノック」の記事

11本目：セル結合の警告
 12本目：セル結合を解除
 13本目：文字列の部分フォント
14本目：社外秘シート削除
15本目：シートの並べ替え
 16本目：無駄な改行を削除
 17本目：重複削除（ユニーク化）
18本目：名前定義の削除
 19本目：図形のコピー
 20本目：ブックのバックアップ
 21本目：バックアップファイルの削除

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.変数宣言のDimとデータ型｜VBA入門
4.繰り返し処理（For Next)｜VBA入門
5.RangeとCellsの使い方｜VBA入門
6.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
7.セルのクリア（Clear,ClearContents）｜VBA入門
8.メッセージボックス(MsgBox関数)｜VBA入門
9.条件分岐（Select Case）｜VBA入門
10.ブック・シートの選択（Select,Activate）｜VBA入門

ホーム
マクロVBA入門編
VBA100本ノック
14本目：社外秘シート削除

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。

VBA練習問題
VBA100本ノック 14本目：社外秘シート削除