【自分用】ExcelVBAパーツ

高速化のための抑止設定

'抑止設定
Application.ScreenUpdating = False '画面更新OFF
Application.Calculation = xlCalculationManual 'シート計算-手動
Application.DisplayAlerts = False '警告表示OFF

'抑止設定の解除
Application.ScreenUpdating = True '画面更新ON
Application.Calculation = xlCalculationAutomatic 'シート計算-自動
Application.DisplayAlerts = True '警告表示ON

フォルダ内の全ブックを開いて処理

Private Const TARGET_FOLDER_PATH As String = "" '対象フォルダパス
Private Const FOLDER_SEPARATOR As String = "\"
Private Const BOOK_NAME_FORMAT As String = "*.xls*"
Private Const TARGET_FOLDER_PATH_WITH_SEPARATOR As String = TARGET_FOLDER_PATH & FOLDER_SEPARATOR

'フォルダ直下の全ブックを開いて処理する処理
Private Function allBookProcess(Optional editFlag As Boolean = False)
    Dim targetBookName As String
    Dim targetBook As Workbook
    
    targetBookName = Dir(TARGET_FOLDER_PATH_WITH_SEPARATOR & BOOK_NAME_FORMAT, vbNormal)
    
    Do While targetBookName <> ""
        Set targetBook = Workbooks.Open(Filename:=TARGET_FOLDER_PATH_WITH_SEPARATOR & targetBookName, ReadOnly:=Not (editFlag))
        Call myBookProcess(targetBook)
        targetBook.Close SaveChanges:=editFlag
        targetBookName = Dir()
    Loop
End Function

'フォルダ配下の全ブックを開いて処理する処理
'【注意】「Microsoft Scripting Runtime」への参照設定が必要。
Private Function allFolderAllBookProcess(targeFolderPath As String, Optional editFlag As Boolean = False, Optional scanSubFolderFlag As Boolean = False)
    Dim fso As FileSystemObject
    Dim topFolder As Folder
    Dim tempFile As File
    Dim targetBook As Workbook
    Dim subFolder As Folder
    
    Set fso = New FileSystemObject
    Set topFolder = fso.GetFolder(targeFolderPath)
    
    'フォルダ直下の全ブックを開いて処理
    For Each tempFile In topFolder.Files
        If tempFile.Name Like BOOK_NAME_FORMAT Then
            Set targetBook = Workbooks.Open(Filename:=tempFile.Path, ReadOnly:=Not (editFlag))
            Call myBookProcess(targetBook)
            targetBook.Close SaveChanges:=editFlag
        End If
    Next
    
    'フォルダ配下のサブフォルダの全ブックを開いて処理
    If scanSubFolderFlag = True Then
        For Each subFolder In topFolder.SubFolders
            Call allFolderAllBookProcess(subFolder.Path, editFlag, True)
        Next
    End If
End Function

'開いている各ブックに対する処理
Private Function myBookProcess(myBook As Workbook)
    
End Function

数式列追加

Private Const ADD_START_COLUMN As Integer = 4 '数式列を追加する先頭列
Private Const HEADER_START_ROW As Integer = 1 'ヘッダー行の先頭行
Private Const DATA_START_ROW As Integer = 2 'データ行の先頭行

'対象の数式列のヘッダーと数式の文字列
Private Const FORMULA_HEADER1 As String = "ヘッダー1"
Private Const FORMULA1 As String = "=A2&B2"
Private Const FORMULA_HEADER2 As String = "ヘッダー2"
Private Const FORMULA2 As String = "=B2&C2"

'数式列追加
Private Function addFormulaColumn(targetSheet As Worksheet)
    Dim myCalculationMode As XlCalculation
    Dim formulaHeaderArray As Variant
    Dim formulaArray As Variant
    
    myCalculationMode = Application.Calculation
    formulaHeaderArray = Array(FORMULA_HEADER1, FORMULA_HEADER2) '要メンテナンス
    formulaArray = Array(FORMULA1, FORMULA2) '要メンテナンス
    
    Application.Calculation = xlCalculationManual
    
    targetSheet.Cells(HEADER_START_ROW, ADD_START_COLUMN).Resize(1, UBound(formulaHeaderArray) + 1).Value = formulaHeaderArray
    With targetSheet.Cells(DATA_START_ROW, ADD_START_COLUMN).Resize(1, UBound(formulaArray) + 1)
        .Value = formulaArray
        .AutoFill .Resize(targetSheet.UsedRange.Rows.Count - DATA_START_ROW + 1, .Columns.Count)
    End With
   
   Application.Calculate
   Application.Calculation = myCalculationMode
End Function