【ExcelVBA】自動化ツールのご紹介

ExcelVBAとは

ExcelVBAの自動化ツール

'*****************************************************************

'指定フォルダ内の全てのワークブック(.xls)を集計

'*****************************************************************



Option Explicit

'◆集計マクロ

'集計対象フォルダ

Private Const cnsStrlngShukeiTaisyo As String = "B3"

'合計値セットエリア

Private Const cnsStrGoukei As String = "H5"

'値の確認セットエリア

Private Const cnsStrAtaiKakunin As String = "H6"

'処理時間セットエリア

Private Const cnsStrSyoritime As String = "H7"

'シート名

Private Const cnsStrSheetName As String = "集計"

'◆集計ファイル

'合計エリア

Private Const cnsStrlngShukeiArea As String = "D8"

'ファイルパス区切り文字

Private Const cnsStrYen As String = "\"

'集計値保持用

Private lngShukei As Long

'値の確認保持用

Private strAtai As String

'******************************************************************

'指定フォルダ内の全てのワークブック(.xls)を集計

'******************************************************************

Sub 集計開始_Click()

    '宣言

    Dim xlAPP As Application

    Dim strPathName As String

    Dim strFileName As String

    Dim VarStartTime As Single

    Dim VarStopTime As Single

    Dim VarSyoriTime As Single

    

    'エラーハンドリング

    On Error GoTo SyoriEXIT

    

    '処理時間計測開始

    VarStartTime = Timer

    

    '初期値セット

    lngShukei = 0

    strAtai = ""

    strPathName = ""

    strFileName = ""

    'リセット

    ThisWorkbook.Worksheets(cnsStrSheetName).Range(cnsStrGoukei).Value = ""

    ThisWorkbook.Worksheets(cnsStrSheetName).Range(cnsStrAtaiKakunin).Value = ""

    ThisWorkbook.Worksheets(cnsStrSheetName).Range(cnsStrSyoritime).Value = ""

    'フォルダ名取得

    strPathName = ThisWorkbook.Worksheets(cnsStrSheetName).Range(cnsStrlngShukeiTaisyo)

    'フォルダ・ファイル存在チェック

    If strPathName <> "" Then

        'フォルダ存在チェック

        strFileName = Dir(strPathName, vbDirectory)

        If strFileName = "" Then

            MsgBox "指定されたフォルダは存在しません。"

            '処理終了

            Exit Sub

        End If

        strFileName = Dir(strPathName & "\*.xls")

        If strFileName = "" Then

            MsgBox "指定されたフォルダにはExcelファイルが存在しません。"

            '処理終了

            Exit Sub

        End If

    Else

        MsgBox "集計対象フォルダを指定してください。"

        '処理終了

        Exit Sub

    End If

    

    Set xlAPP = Application

    With xlAPP

        '画面描画停止

        .ScreenUpdating = False

        'イベント停止

        .EnableEvents = False

        'カーソルを砂時計にする

        .Cursor = xlWait

    End With

    'ファイル名が存在する間

    Do While strFileName <> ""

        DoEvents

        'ファイルを開き、処理実行

        Call FileOpenProc(strPathName, strFileName)

        ' 次のファイル名を参照

        strFileName = Dir

    Loop

    '処理時間計測終了

    VarStopTime = Timer

    '処理時間をセット

    VarSyoriTime = VarStopTime - VarStartTime

    '値をセット

    ThisWorkbook.Worksheets(cnsStrSheetName).Range(cnsStrGoukei).Value = lngShukei

    ThisWorkbook.Worksheets(cnsStrSheetName).Range(cnsStrAtaiKakunin).Value = strAtai

    ThisWorkbook.Worksheets(cnsStrSheetName).Range(cnsStrSyoritime).Value = Round(VarSyoriTime, 0) & "秒"

SyoriEXIT:

    If Not xlAPP Is Nothing Then

        With xlAPP

            '画面描画再開

            .ScreenUpdating = True

            'イベント再開

            .EnableEvents = True

            'カーソルを矢印（デフォルト）にする

            .Cursor = xlDefault

        End With

        'オブジェクト解放

        Set xlAPP = Nothing

    End If

End Sub

'*****************************************************************

'ワークブックを開き、集計

'*****************************************************************

Private Sub FileOpenProc(strPathName As String, strFileName As String)

    'ワークブック用のオブジェクト

    Dim objWBK As Workbook

    ' ワークブックを読み取り専用で開く

    Set objWBK = Workbooks.Open(Filename:=strPathName & cnsStrYen & strFileName, ReadOnly:=True)

    '各ファイルの合計値を記述

    strAtai = strAtai & "[" & strFileName & ":" & objWBK.Worksheets(1).Range(cnsStrlngShukeiArea) & "]"

    '集計値を合算する

    lngShukei = lngShukei + objWBK.Worksheets(1).Range(cnsStrlngShukeiArea)

    'ファイルを保存せず、閉じる

    objWBK.Close SaveChanges:=False

    'オブジェクト解放

    Set objWBK = Nothing

End Sub

'*****************************************************************

'フォルダ選択ボタン押下時処理

'*****************************************************************

Sub フォルダ選択_Click()

    'フォルダダイアログ表示

    With Application.FileDialog(msoFileDialogFolderPicker)

        If .Show = True Then

            '選択されたパスをセット

            ThisWorkbook.Worksheets(cnsStrSheetName).Range(cnsStrlngShukeiTaisyo).Value = .SelectedItems(1)

        End If

    End With

End Sub

関連する記事

【ExcelVBA】マクロを高速化する３つの方法 基本情報技術者試験の勉強法について 【AccessVBA】AccessVBAスタンダード試験に挑戦！ 入社前にプログラミングの基礎を勉強しておきたい未経験の人におすすめのサイト～HTML・CSS～

• Tweet
•