[[20161018120515]]　『Sheet検索について』（かつ）　ページの最後に飛ぶ

『Sheet検索について』（かつ）

お疲れ様です。VBA勉強中で試行錯誤して
一応は思い通りの動作をしているコードを書きましたが
はたしてそれが合っているのか疑問で投稿させていただきました。

Fドライブを増設していましてその中に管理データーのファイルを
数個に分けて保存してあります。

Fドライブの中に、管理帳簿と言うフォルダー、その中に年度ごとのフォルダー（　2014年＆2015年＆2016年　）その中に日報.xlsm（マクロ有効ブック）と言うファイルが入っています。このブックは月ごとにSheetをわけていて、最終的に今年の今月のSheetを開くというコードです。

F:\管理帳簿\2016年（今年）の日報.xlsmの今月のシートです。

デスクトップにデーター管理としてトップ画面を置いていてそのブックの中のコマンドボタンで
動作するようにしています。

　Private Sub CommandButton1_Click()

　Const Folder_Path As String = "F:\管理帳簿"　’ここまで固定で指定

　Dim Fname As String
　Dim SFolder As String
　Dim Ws As Worksheet
　Dim Mname As String
　Application.ScreenUpdating = False

　SFolder = Format(Date, "yyyy年")
　Fname = Dir(Folder_Path & "\" & SFolder & "\" & "日報.xlsm")

   If Fname <> "" Then
   Workbooks.Open (Folder_Path & "\" & SFolder & "\" & "日報.xlsm")
   End If

　For Each Ws In Worksheets
　Mname = Format(Date, "mm月")

   If Ws.Name = Mname Then
   Ws.Select
   End If

　Next Ws

　Application.ScreenUpdating = True
　End Sub
エラー処理や間違いなどのご教授をお願いいただければと思います。

＜使用 Excel：Excel2007、使用 OS：WindowsVista ＞

 ざっと眺めたレベルでのメモです。アップされたコードに注釈番号をつけてみました。

Private Sub CommandButton1_Click()

    Const Folder_Path As String = "F:\管理帳簿"  'ここまで固定で指定
    Dim Fname As String
    Dim SFolder As String
    Dim Ws As Worksheet
    Dim Mname As String
    Application.ScreenUpdating = False
    SFolder = Format(Date, "yyyy年")
    Fname = Dir(Folder_Path & "\" & SFolder & "\" & "日報.xlsm")

    '★1
    If Fname <> "" Then
        Workbooks.Open (Folder_Path & "\" & SFolder & "\" & "日報.xlsm")
    End If
    '★2
    For Each Ws In Worksheets           '★2-1
        Mname = Format(Date, "mm月")    '★2-2

        If Ws.Name = Mname Then
            Ws.Select
        End If
    Next Ws                             '★2-3

    Application.ScreenUpdating = True
End Sub

 まず★1 のブロックと　★2 のブロックですが、もし、★1 で該当のブックがなかった場合でも
 無条件に　★2 のブロックが実行されますね。
 対象ブックが開かれていないわけですから、具合悪いですね。
 取得した結果が "" なら Exit Sub （必要なら、ないと　というメッセージも表示して）する。
 あった場合のみ、処理を継続するという流れが必要でしょうね。

 また、★2 、シートをループ処理で取り出していますが、直接、そのシートを指定する方法もあります。
 もちろん、ない場合も想定してエラートラップは必須ですけど、コードが短くなります。

 ★2-1 、該当のブックが開かれていますので、アクティブブックだということになりますから
 For Each Ws In Worksheets でも、結果オーライですが、その前のブックを開く時点でそのブックをWorkbookオブジェクトにいれておいて
 For Each Ws In そのオブジェクト.Worksheets としたほうが、気持ちがいいというか、状況依存じゃなくなるので
 おすすめです。

 ★2-2 、細かいことを言えば　ループの中で、毎回　Mname = Format(Date, "mm月")　。
 毎回、同じ値を取得していますね。ループの外で、最初に１回やっておけばよろしいかと。

 ★2-3 、結果オーライですが、シートが見つかって　ws.Select とやれば、もう、あとは処理しなくていいですよね。
 なのに、そのあとも、ループ処理を続けています。ws.Select のあとに Exit For と記述して、ループをぬけたほうがいいですね。

（β） 2016/10/18(火) 13:18

私からの改善案としては、「Excelに限らず、openした資源はcloseする事！」という点と、「1回しか使わない変数は、使わない方が判りやすくなる」という点を挙げておきます。

 Private Sub CommandButton1_Click()
    Const Folder_Path As String = "F:\管理帳簿"  'ここまで固定で指定
    Dim Fname As String
    Dim Ws As Worksheet
    Dim Mname As String

    Application.ScreenUpdating = False

    Fname = Folder_Path & "\" & Format(Date, "yyyy年") & "\" & "日報.xlsm"

    If Dir(Fname) <> "" Then
        With Workbooks.Open(Fname)
            Mname = Format(Date, "mm月")

            For Each Ws In .Worksheets
                If Ws.Name = Mname Then
                    MsgBox Ws.Name & "の処理をここに記述します"
                    Exit For
                End If
            Next Ws

            .Close
        End With
    End If

    Application.ScreenUpdating = True
 End Sub
（???） 2016/10/18(火) 13:53

もう1点。ブックは1年間変わらず同じ場所にあるのでしたら、Dir関数による存在確認は無くても良かったりしませんかね？
ブックをチェックしている割には、シートが無い場合を想定していないのが気になりました。
（???） 2016/10/18(火) 13:57

 ???さんの指摘にもありますが以下のように、乱暴に（？）直接開いてもいいかもしれません。

Private Sub CommandButton1_Click()

    Const Folder_Path As String = "F:\管理帳簿"  'ここまで固定で指定
    Dim SFolder As String
    Dim Mname As String

    Application.ScreenUpdating = False
    SFolder = Format(Date, "yyyy年")
    Mname = Format(Date, "mm月")

    On Error Resume Next
    Workbooks.Open(Folder_Path & "\" & SFolder & "\" & "日報.xlsm").Worksheets(Mname).Select
    On Error Resume Next

    If ActiveWorkbook.Name <> "日報.xlsm" Then
        MsgBox "ブックが存在しません"
    ElseIf ActiveSheet.Name <> Mname Then
        MsgBox "シート:" & Mname & " が存在しません"
    End If

    Application.ScreenUpdating = True

End Sub

（β） 2016/10/18(火) 14:46

βさん???さんご教授ありがとうございます。

βさんの最初の★1と★2-3は訂正できたと思います。

★1を
　If Fname <> "" Then

   Workbooks.Open (Folder_Path & "\" & SFolder & "\" & "日報.xlsm")
   Else
   Fname = ""
   MsgBox "フォルダーが存在しません。"
   Exit Sub
   End If
に書き換えてみました。
★2-3は　ws.Select のあとに Exit For　これでループを抜けれるのですね。

★2　★2-1　★2-2　をまた勉強してみます。
それと???さんβさんの新しいコードもすごく参考になります。

βさんの
　On Error Resume Next
　Workbooks.Open(Folder_Path & "\" & SFolder & "\" & "日報.xlsm").Worksheets(Mname).Select
　On Error Resume Next
の下の
　On Error Resume Nextはある方がいいのですか？
（かつ） 2016/10/18(火) 16:28

あ、βさんの2つ目の On Error Resume Next はコピペミスで、On Error Goto 0 でエラー時割り込みの解除をするのが正解ですね。
（???） 2016/10/18(火) 17:05

またまた有難うございます。

こう言うことですか？
　
　On Error Resume Next
　Workbooks.Open(Folder_Path & "\" & SFolder & "\" & "日報.xlsm").Worksheets(Mname).Select
　On Error Goto 0

なくても処理はしてくれるのですが
　On Error Goto 0でエラーがなければOn Error Resume Nextを
終了させる解除するということですね？
（かつ） 2016/10/18(火) 17:42

On Error Resume Next は、エラーがあった場合は次の行に移動する、というエラー時割り込みを開始しなさい、という意味。
On Error Goto 0 は、エラー時割り込みを解除しなさい、という意味。（エラーがあると停止する、初期状態に戻ります）

On Error処理は、使い方が判りにくいので、勉強中とか初心者さんとかは、一切使用しない方が望ましいです。

βさんの例は、もしファイル名が間違っていたり、壊れたりしていても、エラー停止させない事を1行で実現してしまう方法です。
しかし、エラー時割り込みを解除しないと、以降の行でエラーがあっても止まらず、原因が判らない、という事になりかねないのですよ。
（openしているのにcloseしないようなレベルでは、危険な命令です）
（???） 2016/10/18(火) 17:52

βさん???さん
瞬時にわかりやすい回答いただき有難うございます。エラーの事もですが
それ以前の事も参考にさせていただき　また試行錯誤してみます。

（かつ） 2016/10/18(火) 18:44

 おはずかしい、うっかりミスでしたね。（汗）

 ??? さん、フォロー深謝です。

（β） 2016/10/18(火) 19:09

コメント返信：

[ 一覧(最新更新順) ]

[[20161018120515]] 『Sheet検索について』（かつ） ページの最後に飛ぶ

[[20161018120515]]　『Sheet検索について』（かつ）　ページの最後に飛ぶ