Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2016)
複数シートを選択し、指定セル範囲のデータをクリアしたい
投稿日時: 20/03/22 15:10:05
投稿者: TI

こんにちは。
 
タイムカードのデータをエクセルで管理をしており、ブックが10枚程度あり、
各ブックに同じ形式のシートが10〜15枚あります。
 
そこで、あるブックからそれぞれのデータの入っているブックを順番に開き、
タイムカードデータのシートのみを複数選択して、一括して指定した
範囲のデータをクリアしたいと考えております。
(タイムカード以外のデータが入っているシートが2枚あります。)
(もともと、1枚ずつのシートを選択してデータのクリアをしておりましたが、
 時間が結構かかるので、一括データクリアとの比較をしたいと考え、
 作業中です。)
 
ブック内の指定したシート以外を配列に格納しております。
(1)の段階では配列にシート名が格納されておりますが、その後
「DataClear2」というプロシージャに引数として渡すと配列に
データはいっていない状態となっているようです。
 
そのためだと思うのですが、(2)の部分で
「インデックスが有効範囲にありません」
とのエラーが出ます。
 
いろいろと調べてはいるのですが、どうしても問題の糸口をつかむことが
出来ません。
 
どうか、アドバイスをお願いします。
 
Sub AllSheetDataClear2(ReturnBook As Workbook _
                        , TargetBook As Workbook)
Dim Sht As Worksheet
Dim AllShtName() As String '全シート名
Dim ClearShtName() As String 'データクリア対象シート(配列に格納)
Dim i As Integer
Dim j As Integer
Const StartRow As Integer = 2
Dim Endrow As Integer
Const ShtClm As Integer = 1 'シート名列挙列
Dim ReturnBookWs As Worksheet
Dim AryExcepSheet As Variant 'データ削除対象外シート名を格納
Dim ClearRange As String 'データクリア範囲
 
    Set ReturnBookWs = ReturnBook.Sheets("Sheet1")
    ClearRange = ReturnBookWs.Range("E2").Value
     
    '初期化
    j = 0
    ReDim ClearShtName(0)
     
    'Endrow = GetEndRow(Ws, ShtClm)
     
    'データ削除対象外シート名を配列にセット
    'この場合の開始は「1」からとなる(Excelの仕様)
    AryExcepSheet = GetAryExceptionSheet(ReturnBook)
         
        '全シートを対象に処理をする
        For Each Sht In TargetBook.Worksheets
         
             
            'データクリア対象外シートのみを選択する
            For i = 1 To UBound(AryExcepSheet)
                 
                '除外対象シートの場合は、選択する
                If Sht.Name = AryExcepSheet(i, 1) Then
                     
                    GoTo Continue
                     
                End If
 
            Next
             
            'データクリア対象のシート名を配列に格納
            ReDim ClearShtName(j)
            ClearShtName(j) = Sht.Name          →(1)
             
            j = j + 1
             
 
Continue:
                 
        Next
         
        'Set Shts = Sheets(Selection)
         
        'データ削除
        Call DataClear2(TargetBook, ClearRange, ClearShtName)
         
 
End Sub
 
 
'****************************************************************************************
'データ削除
'削除範囲 A2:D30
'****************************************************************************************
Sub DataClear2(Wb As Workbook, ClearRange As String, ClearShtName() As String)
Dim Rng As Range
Dim StrRng As String
Dim i As Integer
 
    StrRng = ClearRange
        
    Wb.Activate
    Wb.Worksheets(ClearShtName).Select          →(2) ここでエラーになる
    Selection.Range(StrRng).ClearContents
     
    'Ws.Activate
    'Ws.Range(StrRng).ClearContents
' Sheets(Ws).Active
    'Sheets(Ws).Range(StrRng).ClearContents
   
End Sub

回答
投稿日時: 20/03/22 15:45:26
投稿者: WinArrow
投稿者のウェブサイトに移動

コードが複雑な感じがする。&無駄なコードがたくさんありそう。
 
すっきりコードの例
ExSHT に削除非対称のシート名を文字列で指定します。
 
Sub test()
Dim wbk As Workbook
Dim ExSHT As String
    Set wbk = tgisworkbook
    ExSHT = "Sheet1,Sheet2,Sheet3"
End Sub
 
 
Sub DATACLEaR(wbk As Workbook, ExSHT As String)
Dim Sht As Worksheet
     
    For Each Sht In wbk.Sheets
        If InStr(Sht.Name, ExSHT) = 0 Then
            Sht.UsedRange.ClearContents
        End If
    Next
     
End Sub

回答
投稿日時: 20/03/22 15:50:15
投稿者: WinArrow
投稿者のウェブサイトに移動

クリアするセル範囲が決まっているならば
 
> Sht.UsedRange.ClearContents

 
            Sht.Range("A2:D30").ClearContents
 
に変更すればよいでしょう。

回答
投稿日時: 20/03/22 15:52:09
投稿者: WinArrow
投稿者のウェブサイトに移動

追加レス
 
ブックの選択も、シートの選択、セル範囲の選択も
必要ありません。
選択すると、レスポンスが落ちます。

回答
投稿日時: 20/03/22 16:14:03
投稿者: WinArrow
投稿者のウェブサイトに移動

コードにミスがありましたので
修正して再掲します。
  
Sub test()
  Dim wbk As Workbook
  Dim ExSHT As String
      Set wbk = Thisworkbook
      ExSHT = "Sheet1,Sheet2,Sheet3"
     Call DATACLEAR(wbk, ExSHT)
  End Sub
     
     
  Sub DATACLEaR(wbk As Workbook, ExSHT As String)
  Dim Sht As Worksheet
         
      For Each Sht In wbk.Sheets
          If InStr(ExSHT, Sht.Name) = 0 Then
              Sht.UsedRange.ClearContents
          End If
      Next
         
  End Sub

投稿日時: 20/03/22 18:10:08
投稿者: TI

WinArrow様
 
ご回答ありがとうございます。
 
私の説明が悪く申し訳ないのですが、今使用中のコードは
WinArrow様がお提示いただいたものほどすっきりとしたものでは
ありませんが、1シートごとにセル範囲のデータをクリアするものに
なっております。
 
もともと、今回の作業自体が手作業にて、
・ブックを開く
・データクリア対象のシートを選択する
・特定のデータをクリアする(Deleteキーにて)
 
他のブックに対しても、上記の作業を繰り返す
 
としていたものをマクロ化しました。
 
ただし、上記の作業手順の内、
>・データクリア対象のシートを選択する
 
ということが実現できなかったので、For Eachにて1シートずつ
データクリアを実行しております。
 
こちらのマクロが時間がかかったので、もともと作業で行っていたことを
完全にマクロ化した場合の実行時間と比較をしたかったので、今回の質問内容の
マクロを組んでいる次第です。
 
もし、シートを複数選択すること自体が時間がかかる作業ということであれば
今回の件は諦めたいと思います。
 
ご助言いただいた内容をもとに、コードの修正をしてみたいと思いますので、
今しばらくご助言いただけると幸いです。
 
また、わからない点を質問させていただければと思います。

回答
投稿日時: 20/03/22 18:50:21
投稿者: simple

両者の比較をしてみました。
 

Sub Setting()
    '入力
    Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")).Select
    Sheets("Sheet1").Activate
    Range("A1:X1000").Select
    Selection.FormulaR1C1 = "aaaaa"
    '普通こういう書き方はしません。マクロ記録そのままです。
End Sub
Sub test1()
    Dim t
    t = Timer

    '出力
    Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")).Select
    Sheets("Sheet1").Activate
    Range("A1:X1000").Select
    Selection.ClearContents
    Debug.Print Timer - t; "   一括処理"
End Sub
Sub test2()
    Dim ws As Worksheet
    Dim t
    t = Timer

    '出力
    For Each ws In Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5"))
        ws.Range("A1:X1000").ClearContents
    Next
    Debug.Print Timer - t; "   For each"
End Sub

Sub testNain()
    Dim k As Long
    For k = 1 To 5
        Call Setting
        Call test1
        Call Setting
        Call test2
    Next
End Sub

(1)結果は以下。
 0.03125 一括処理
 0.015625 For each
 0.03125 一括処理
 0.015625 For each
 0.03125 一括処理
 0.0234375 For each
 0.0234375 一括処理
 0.015625 For each
 0.03125 一括処理
 0.015625 For each
キャッシュが影響しているのかもしれませんが、
少なくとも個々のシート毎に実行したほうが著しく遅くなるということはなく、
むしろ早い感じです。
 
(2)シートをグループした処理に比べて、個々シートの処理が遅いというなら、
それは多分、消去に伴う再計算が影響しているかもしれません。
処理の最初で、
Application.Calculation = xlCalculationManual
とし、最後に
Application.Calculation = xlCalculationAutomatic
とすると両者の差は縮まるように思います。

投稿日時: 20/03/22 20:26:37
投稿者: TI

simple様
 
ご回答ありがとうございます。
 
ご指摘の通り、各シートにかなりの数の計算式が埋め込んであります。
 
ただ、実際に
Application.Calculation = xlCalculationManual
 
を組み込んでみましたが、こちらのテスト環境では2秒短縮と
なりました。
 
まずは、1シートずるデータをクリアする方法で進めてみたいと
思います。
 
 WinArrow様、simple様、アドバイスありがとうございます。