【Excel VBA】各シートへの更新日時表示ツール(コピペで即利用)

 

Excelファイルをシート毎に更新日時を表示させたいと思ったことはないでしょうか。

 

Excelファイルの更新日時はブック単位でしか更新日時をとることができず、一つのファイルを複数の人で更新している場合などに、シート毎に最終更新した日時を記録として残しておきたいと考えたので、このシート毎に更新日時を記録しておけるツールをExcelマクロで作成しました。

 

このツールを使用することで、各シートで更新情報を分けることができて、ブック全体でなく、もう少し細分化した単位であるシート毎に管理ができるようになると思います。

 

是非、当ツールをご活用頂けたらと思います。

 

当ツールの概要(何ができるのか?)

更新日時を表示させたいエクセルファイル内で設定画面(設定シート)を用意して、設定画面に更新日時を記載するセルを指定(全シート共通、またはシート毎に記載するセル位置を分ける)します。

 

後は、設定画面以外のシート内の情報を変更して、保存することで指定したセルに更新日時を自動的に記載してくれます。

 

下に説明動画を載せますので、ご確認ください。動画を見ると分かりやすいと思います。

 

<説明動画> ※映像のみで音声はありません。

 

ツールの使用方法

基本的な機能、操作方法の説明

1.更新日時をシート毎に管理したいExcelファイル(当ツールのマクロ付き)を開きます。

※当ツールのVBAコードを含んでいて、「設定」シート(設定情報を書き込めるシート)がファイル内に存在している状態のファイルです

 

2.「設定」シートに更新日時を記載するセル位置を記載します。

各シート毎に更新日時を記載するセル位置を変える場合は、個別指定するシート名とセル位置を記載します。

 

3.「設定」シート以外のシートでセル内の値を変更してファイルを保存すると、

 

上記2で指定したセル位置に更新日時が記載されます。

 

また、他のシート内のセルを変更してファイルを保存した場合でも、3の操作で表示された更新日時は変更されません。

 

なお、「設定」シートは、シート自体を非表示にしても動作しますので、他の人に見せる必要がない場合は、シートを非表示にしておくことをお勧めします。

 

また、更新日時だけでなく、変更前の値、変更後の値値や更新者情報も表示させることができますので、必要に応じてカスタマイズして頂ければと思います。

 

他に要望等ありましたら、可能な限り改修等を対応しますのでコメント頂ければと思います

 

留意事項

更新の判断基準

このツールでの変更の判断は、セル内の値に変更があった場合に更新されたと判断して、更新日時を表示させます。

そのため、セル色の変更や文字色の変更のみをした場合などは更新されたと判断しないため、ファイルを保存しても更新日時は変更されません。

 

使用する際の事前準備

このページの下部にある「Excelファイルのサンプル」からExcelファイルを取得し、「準備の手順」内にあるVBAコードを取得したExcelファイルに記載して保存すれば、すぐに当ツールを使用できます。

 

以下にその手順を説明していきます。

 

準備の手順

1.「サンプルのダウンロードはこちら」からサンプル(Excelファイル)をダウンロードします。

※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、設定画面(設定シート)が入っているマクロ無しExcelファイルを公開しています

※このサイトからExcelファイルをダウンロードしなくても、設定シートが下記の画像とセル位置が同一のシートを作れば当ツールを動かすことができます

 

2.ダウンロードしたExcelファイル内にある「setting」シートを更新日時を管理したいExcelファイルにコピーします。

 

3.2でコピーしたExcelファイルの上部にあるリボンの「開発」タブから「visual basic」を選択して、VBE(visual basic for application)を起動させます。

 

リボンに「開発」タブが表示されていない場合は、以下を参照ください。

(参考サイト:記事「Excel VBAを始める前に、最初にやっておくべき初期設定内容はこれ」の『開発』タブを表示させる

 

4.「プロジェクト」内の「ThisWorkbook」にVBAコードを記載します。

 

VBAコードの右上のアイコンをクリックするとソースコードをコピーできます。

Option Explicit

'====(設定値)=================
Private Const DataRow = 5                       '設定シート内の設定表が開始する行番号
Private Const DataCol = 4                       '設定シート内の設定表(個別設定)が開始する列番号
Private Const DataColNm = "D"                   '設定シート内の設定表(個別設定)が開始する列名
Private Const SettingSheetNm = "setting"        '設定シートのシート名称
'===============================

Dim SelRange As String
Dim XCol, YRow As Long

Dim TgtEachlist() As String                     '個別設定のリスト(シート名、セル位置)
Dim TgtCellPoint As String                      '一括設定のセル位置
Dim TgtUpdateList() As String                   '変更したシート等の情報が格納されたリスト

Dim BaseBook As Workbook
Dim SettingSheet As Worksheet

Dim CntChange As Integer

'エクセル起動時に実行します
Private Sub Workbook_Open()

    ReDim TgtUpdateList(2, 0)
    
    '設定情報を取得する
    Call GetSetting
    
End Sub
 
'エクセル内のセル等を選択した時に実行します
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    On Error Resume Next
    
    '変更前のセル内容を一時保管します。
    SelRange = ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column).Value
    
End Sub

'エクセル内の値を変更した時に実行します
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Call GetSetting
    
    Dim i As Long
    Dim exitFlg As Boolean: exitFlg = False
    
    Application.EnableEvents = False
    
    'シート「setting」以外のシートで変更があった場合のみ処理する
    If ActiveSheet.Name <> SettingSheetNm Then
 
        XCol = Target.Column
        YRow = Target.Row
        
        ReDim Preserve TgtUpdateList(2, CntChange)
                
        '値が変更されていた場合のみ処理する
        If SelRange <> ActiveSheet.Cells(YRow, XCol).Value Then

            '既に存在していないかをチェックする
            For i = 0 To UBound(TgtUpdateList, 1)

                If TgtUpdateList(i, 0) = ActiveSheet.Name Then
                    exitFlg = True
                    Exit For
                End If
            Next

            If exitFlg = False Then

                '個別設定があれば、そのセル位置を取得する
                For i = 0 To UBound(TgtEachlist, 1)

                    If ActiveSheet.Name = TgtEachlist(i, 0) Then
                        TgtUpdateList(1, CntChange) = TgtEachlist(i, 1)                 'セル位置
                        Exit For
                    End If
                Next

                '個別設定がなければ、一括設定のセル位置を取得する
                If TgtUpdateList(1, CntChange) = "" Then
                    TgtUpdateList(1, CntChange) = TgtCellPoint                          'セル位置
                End If

                TgtUpdateList(0, CntChange) = ActiveSheet.Name                          'シート名
                TgtUpdateList(2, CntChange) = Format(Now(), "YYYY/MM/DD HH:MM:SS")      '更新時間

                CntChange = CntChange + 1

            End If
        End If
    End If
 
    Application.EnableEvents = True
 
End Sub

'エクセル保存時に実行します
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    On Error GoTo ERROR_
    
    Dim i As Long
    
    '変更情報があれば指定されたセルに更新情報を記載する
    If TgtUpdateList(2, 0) <> "" Then
        For i = 0 To UBound(TgtUpdateList, 2)
            
            ActiveWorkbook.Sheets(TgtUpdateList(0, i)).Range(TgtUpdateList(1, i)).Value = Format(Now(), "YYYY/MM/DD HH:MM:SS")
        Next
    End If
    
    CntChange = 0
    ReDim TgtUpdateList(2, CntChange)

ERROR_:
End Sub

'設定値を取得する
Private Sub GetSetting()

    Dim lastRow As Integer
    Dim i As Long
    
    Set SettingSheet = ActiveWorkbook.Sheets(SettingSheetNm)
    
    '一括設定で指定された更新日時を記載するセル位置を取得する
    TgtCellPoint = SettingSheet.Cells(DataRow, 2).Value
    
    'リストの最終行を検索
    lastRow = SettingSheet.Cells(Rows.Count, DataColNm).End(xlUp).Row
    
    If lastRow < DataRow Then
        End
    End If
    
    ReDim TgtEachlist(lastRow - DataRow, 2)
    
    For i = DataRow To lastRow
        
        If SettingSheet.Cells(i, DataCol).Value <> "" And SettingSheet.Cells(i, DataCol + 1).Value <> "" Then
            
            TgtEachlist(i - DataRow, 0) = SettingSheet.Cells(i, DataCol).Value
            TgtEachlist(i - DataRow, 1) = SettingSheet.Cells(i, DataCol + 1).Value
            SettingSheet.Cells(i, DataCol).Font.ColorIndex = 1
            SettingSheet.Cells(i, DataCol + 1).Font.ColorIndex = 1
        Else
            SettingSheet.Cells(i, DataCol).Font.ColorIndex = 3
            SettingSheet.Cells(i, DataCol + 1).Font.ColorIndex = 3
            
        End If
    Next

End Sub

 

5.作成したExcelファイルを「.xlsm」形式(マクロが動作するファイル形式)で保存します。

 

これで事前準備は完了です。

あとは「ツールの使用方法」で記載された方法で当ツールを実行できます。

 

また、このようなExcelVBAを用いた業務効率化を行うときに、以下の書籍が初心者向けでとても参考になると思いますので、良かったらご参照ください。

なお、当マクロの開発環境として、OSは “Windows10” 、Excelのバージョンは “Microsoft Office 365″ で行っており、当環境では動作確認ができていますが、他のすべての環境で正常に動作するかは確認できていません。

 

正常に動作しない場合は、コメントいただければ幸いです。

 

サンプルのダウンロードはこちら

各シートへの更新日時表示ツール

上記よりダウンロードして、VBAコードを組み込んでマクロを使用してください。

 

※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、設定画面(設定シート)が入っているマクロ無しExcelファイルを公開しています

 

コメントを残す

CAPTCHA