解説記事：Excelマクロ

【演算子】

算術演算子

• +　：　足し算
• -　：　引き算
• *　：　掛け算
• /　：　割り算
• ^　：　べき乗
• ¥　：　割り算の結果の整数部分
• Mod　：　割り算の結果のあまり

比較演算子

• > ：　より大きい
• >= ：　以上
• < ：　より小さい
• <= ：　以下
• = ：　等しい
• <> ：　異なる
• Is ：　オブジェクトの比較 (例：A Is Range("A1"))
• Like ：　パターンマッチング (例：VBA Like "V*")

論理演算子

• And ：　A And B ： A,B共に等しいときTrue
• Or ：　A Or B ： AかBが等しいときTrue
• Not ：　Not (A Or B) ： 論理式がTrueならFalse, FalseならTrue

【Withステートメントでコードの重複を避ける】

With Range("A3:F3")
    .Font.Size = 12
    .Font.Bold = True
    .HorizontalAlignment = xlCenter
End With

【Setステートメントでオブジェクトを変数に代入する】

Dim セル As Range
Set セル = Range("A3:F3")
セル.Interior.ColorIndex = 35
セル.HorizontalAlignment = xlCenter
Set セル = Nothing

【Select Caseステートメント】

Select Case Range("F3").Offset(番号).Value
    Case Is >= 250
        セル.Offset(番号).Value = "特進"
    Case Is >= 200
        セル.Offset(番号).Value = "選抜"
    Case Is >= 150
        セル.Offset(番号).Value = "総合"
    Case Else
        セル.Offset(番号).Value = "特訓"
End Select

【On Error GoToステートメントでエラーが起きても安全にマクロを終わらせる】

Sub サブルーチン名()
    On Error GoTo エラー処理
        '処理
    Exit Sub
エラー処理:
    MsgBox "エラー番号:" & Err.Number & "・エラー内容:" & Err.Description
End Sub

【メッセージ画面を表示する】

Sub サブルーチン名()
    Dim ボタン As Integer
    ボタン = MsgBox("データをリセットします。", vbExclamation + vbYesNo, "リセット確認")
    If ボタン = vbYes Then
        Range("B1,C4:E18").ClearContents
        Range("B1").Select
    End If
End Sub

【入力画面を表示する】

Sub サブルーチン名()
    Range("B1").Value = InputBox("シート名を入力", "シート名入力")
End Sub

【対角線を引く】

Sub サブルーチン名()
    Dim 番号 As Integer
    For 番号 = 1 To 5
        Cells(番号 + 2, 番号).Borders(xlDiagonalDown).LineStyle = xlContinuous
    Next
End Sub

【幅高さ整形】

Sub サブルーチン名()
    ActiveCell.EntireRow.AutoFit
    ActiveCell.EntireColumn.AutoFit
End Sub

【セル数のカウント】

Sub サブルーチン名()
    Range("B25:E28").Select
    Range("B25").Activate

    ' セル数のカウント
    Range("B30").Value = Range("B25:E28").Count
    Range("B31").Value = Range("B25:E28").Rows.Count
    Range("B32").Value = Range("B25:E28").Columns.Count
End Sub

【アクティブセルの情報】

Sub サブルーチン名()
    MsgBox ActiveCell.Row & " 行 " & ActiveCell.Column & " 列目のセルがアクティブです。"
End Sub

【下の行、右の列を選択する】

Sub サブルーチン名()
    Range("D36").Offset(-1).Value = "上"
    Range("D36").Offset(1).Value = "下"
    Range("D36").Offset(0, -1).Value = "左"
    Range("D36").Offset(0, 1).Value = "右"
    Range("D36").Offset(-1, -1).Value = "左上"
    Range("D36").Offset(-1, 1).Value = "右上"
    Range("D36").Offset(1, -1).Value = "左下"
    Range("D36").Offset(1, 1).Value = "右下"
End Sub

【表の一番下のセルを参照する】

Sub サブルーチン名()
    ' xlUP : 上方向、xlDown : 下方向、xlToLeft : 左方向、xlToRight : 右方向
    MsgBox "最終行の値: " & Range("A4").End(xlDown).Value
End Sub

【表全体を参照する】

Sub サブルーチン名()
    Range("D12").CurrentRegion.Select
End Sub

【セル範囲を拡大縮小する】

Sub サブルーチン名()
    Dim 行数 As Long, 列数 As Long
    With Range("A41").CurrentRegion
        行数 = .Rows.Count
        列数 = .Columns.Count
        .Offset(1, 2).Resize(行数 - 1, 列数 - 3).NumberFormatLocal = "#,##0"
    End With
End Sub

【空白や数式など特定のセルを参照する】

Sub サブルーチン名()
On Error GoTo エラー処理
    ' 空白セルを取得して×を入力する
    Range("B48:E53").SpecialCells(xlCellTypeBlanks).Value = "×"
    ' 数式が入力されているセルを太字にする
    Range("B48:E53").SpecialCells(xlCellTypeFormulas).Font.Bold = True
    ' 文字が入力されているセルを中央揃えにする
    Range("B48:E53").SpecialCells(xlCellTypeConstants, xlTextValues).HorizontalAlignment = xlCenter
    Exit Sub
エラー処理:
    MsgBox Err.Description
End Sub

引数タイプ

• xlCellTypeComments : コメントが含まれているセル
• xlCellTypeConstants : 定数(引数Valueで種類指定可能)
• xlCellTypeFormulas : 数式(引数Valueで種類指定可能)
• xlCellTypeBlanks : 空白のセル
• xlCellTypeLastCell : 使用されているセル範囲内の最後のセル
• xlCellTypeVisible : 可視セル
• xlCellTypeAllFormatConditions : 条件付き書式が設定されているセル
• xlCellTypeSameFormatConditions : 同じ条件付き書式が設定されているセル
• xlCellTypeAllValidation : 入力規則が設定されているセル
• xlCellTypeSameValidation : 同じ入力規則が設定されているセル

引数タイプ(+で結合することで複数選択可能)

• xlNumbers : 数値
• xlTextValues : 文字
• xlLogical : 論理値 (TRUE, FALSE)
• xlErrors : エラー値 (#DIV/0!, #N/A, #NAME?, #NULL!, #NUM!, #REF!, #VALUE!)

【セルの移動コピー】

Sub サブルーチン名()
    ' コピー＆別シートに貼り付け
    Range("A24:E28").Copy Worksheets("Sheet2").Range("A1")

    ' コピー&貼り付け
    Range("A24:E28").Copy
    ActiveSheet.Paste Worksheets("Sheet2").Range("A9")

    ' 貼り付け先を選択＆リンク貼り付け
    ActiveSheet.Range("A56").Select
    ActiveSheet.Paste Link:=True

    ' リンク貼り付け解除
    ActiveSheet.Paste Link:=False

    ' 形式を指定して貼り付ける
    ' Paste：貼り付ける内容、Operation：演算、SkipBlanks：空白セルを無視する、Transpose：行列入れ替え
    ActiveSheet.Range("A56").PasteSpecial xlPasteFormats

    ' コピーモード解除
    Application.CutCopyMode = False

    ' カット＆ペーストする
    Range("A56:F60").Cut Range("A24")
End Sub

PasteSpecial 引数Paste

• xlPasteAll : すべて
• xlPasteFormulas : 数式
• xlPasteValues : 値
• xlPasteFormats : 書式
• xlPasteComments : コメント
• xlPasteValidation : 入力規則
• xlPasteAllUsingSourceTheme : コピー元のテーマを使用してすべて貼り付け
• xlPasteAllExceptBorders : 罫線を除くすべて
• xlPasteColumnWidths : 列幅
• xlPasteFormulasAndNumberFormats : 数式と数値の書式
• xlPasteValuesAndNumberFormats : 値と数値の書式
• xlPasteAllMergingConditionalFormats : 条件付き書式を結合する

PasteSpecial 引数Operation

• xlPasteSpecialOperationNone : 演算をしない
• xlPasteSpecialOperationAdd : 加算
• xlPasteSpecialOperationSubtract : 減算
• xlPasteSpecialOperationMultiply : 乗算
• xlPasteSpecialOperationDivide : 除算

【セルの挿入】

Sub セルの挿入()
    Range("A4:F4").Insert xlShiftDown, xlFormatFromRightOrBelow
End Sub

Sub 行単位のセルの挿入()
    Rows("42:43").Insert CopyOrigin:=xlFormatFromRightOrBelow
    Columns("C").Insert
    Columns("C").ClearFormats
End Sub

引数Shift

• xlShiftDown : 下にずらす
• xlShiftToRight : 右にずらす

引数CopyOrigin

• xlFormatFromLeftOrAbove : 上、または左のセルから書式をコピーする
• xlFormatFromRightOrBelow : 下、または右のセルから書式をコピーする

【セルの削除】

Sub セルの削除()
    Range("A4:F4").Delete xlShiftUp
End Sub

Sub 行単位のセルの削除()
    Rows("42:43").Delete
    Columns("C").Delete
End Sub

引数Shift

• xlShiftUp : 上にずらす
• xlShiftToLeft : 左にずらす

【行高と列幅の変更】

Sub 行高と列幅の変更()
    Rows(1).RowHeight = 24
    Range("B1").ColumnWidth = 12
    Columns("C:E").ColumnWidth = 5
End Sub

Sub 標準の行高と列幅()
    Rows(1).UseStandardHeight = True
    Range("B1").UseStandardWidth = True
    Columns("C:E").UseStandardWidth = True
End Sub

Sub 行高と列幅の自動調整()
    Range("B1").Columns.AutoFit
End Sub

【行列の表示・非表示】

Sub 行列の表示非表示トグル()
    Rows("41:44").Hidden = Not Rows("41:44").Hidden
    Columns("C:E").Hidden = Not Columns("C:E").Hidden
End Sub

【セルの結合・解除】

Sub セルの結合解除()
    ' セルの結合
    Range("B1:F1").MergeCells = True
    ' 結合したセルを中央ぞろえにする
    Range("B1").HorizontalAlignment = xlCenter
    ' 結合したセルのデータ削除
    Range("B1").MergeArea.ClearContents
    ' セルの結合解除
    Range("B1:F1").MergeCells = False
End Sub

HorizontalAlignment プロパティ

• xlGeneral : 標準
• xlLeft : 左揃え
• xlCenter : 中央揃え
• xlRight : 右揃え
• xlFill : 繰り返し
• xlJustify : 両端揃え
• xlCenterAcrossSelection : 選択範囲内で中央
• xlDistributed : 均等割り付け

VerticalAlignment プロパティ

• xlTop : 上揃え
• xlCenter : 中央揃え
• xlBottom : 下揃え
• xlJustify : 両端揃え
• xlDistributed : 均等割り付け

【文字列を折り返して表示】

Sub 文字列を折り返して表示()
    Range("A55").WrapText = True
End Sub

【セルの文字の書式】

Sub 文字の書式()
    Range("A55").Font.Name = "Meiryo UI"
    Range("A55").Font.Size = 16
    Range("A55").Font.Bold = True
    Range("A55").Font.Italic = False
    Range("A55").Font.Underline = True
End Sub

【日付や数値に表示形式を設定する】

Sub 表示形式()
    Range("A58:A61").NumberFormatLocal = "mm/dd"
    Range("B58:B61").NumberFormatLocal = "0000"
    Range("C58:C61").NumberFormatLocal = "#,##0"
End Sub

数値の書式記号

日付の書式記号

時刻/文字の書式記号

【セルや文字に色をつける】

Sub セルに色をつける()
    Range("A57:C57").Interior.ColorIndex = 46
    Range("A57:C57").Font.ColorIndex = 2
End Sub

ColorIndex プロパティ

• インデックス番号 : 下表 (Excel 2003/2002)
• xlColorInexAutomatic : 自動
• xlColorIndexNone : なし

【セルに罫線を引く】

Sub セルに罫線を引く()
    ' 背景色を塗りつぶす
    Range("B65:C66").Interior.ColorIndex = 46
    Range("B68:C70").Interior.ColorIndex = 46
    Range("B72:C73").Interior.ColorIndex = 46
    Range("B75:C76").Interior.ColorIndex = 46
    Range("B79:C80").Interior.ColorIndex = 46
    Range("B82:C83").Interior.ColorIndex = 40
   
    ' 罫線を引く
    With Range("B65:C66").Borders
        .LineStyle = xlDash
        .ColorIndex = 10
        .Weight = xlMedium
    End With
    Range("B68:C70").Borders(xlInsideHorizontal) _
        .LineStyle = xlContinuous
    Range("B72:C73").Borders(xlDiagonalDown) _
        .LineStyle = xlContinuous
    Range("B75:C76").Borders(xlEdgeBottom) _
        .LineStyle = xlDouble
    Range("B79:C80").Borders.LineStyle = xlLineStyleNone

    ' 周囲に罫線を引く
    Range("B82:C83").BorderAround _
        LineStyle:=xlSlantDashDot, ColorIndex:=33, Weight:=xlThick
End Sub

Borders 引数Index

• xlEdgeTop : セル範囲の上端の罫線
• xlEdgeBottom : セル範囲の下端の罫線
• xlEdgeLeft : セル範囲の左端の罫線
• xlEdgeRight : セル範囲の右端の罫線
• xlInsideHorizontal : セル範囲の内側の横罫線
• xlInsideVertical : セル範囲の内側の縦罫線
• xlDiagonalDown : 各セルの右下がりの罫線
• xlDiagonalUp : 各セルの右上がりの罫線

LineStyle プロパティ

• xlContinuous : 実線
• xlDash : 破線
• xlDashDot : 一点鎖線
• xlDashDotDot : 二点鎖線
• xlDot : 点線
• xlDouble : 二重線
• xlSlantDashDot : 斜破線
• xlLineStyleNone : 線なし

Weight プロパティ

• xlHairline : 細線
• xlThin : 中細の線
• xlMedium :　中太の線
• xlThick : 太線

セルにデータや数式を入力する

Sub セルにデータ数式入力()
    '*****
    ' データの入力
    '*****
    Range("A86").Value = 2
    Range("A87").Value = Range("A86").Value + 1
    ' 文字列は"で囲む
    Range("B86").Value = "山田　花子"
    Range("B87").Value = "山田　太郎"
    ' 日付は#で囲む
    Range("C86:C87").Value = #7/3/2012#
    Range("D86:D87").Value = Range("B85").Value
   
    Range("D86").Value = 180
    Range("D87").Value = 160
    Range("E86").Value = 188
    Range("E87").Value = 155
   
    '*****
    ' 数式の入力
    '*****
    Range("D88:E88").Formula = "=SUM(D86:D87)"
    Range("F86:F88").Formula = "=E86/$E$88"
    Range("G86:G88").Formula = _
    "=IF(E86>=D86,""達成"",""未達成"")"
End Sub

【セルに連続データを入力する】

Sub セルに連続データを入力する()
    Range("A90").Value = 1
    Range("A90").AutoFill Range("A90:A94"), xlFillSeries
    Range("B90").Value = #7/25/2012#
    Range("B90").AutoFill Range("B90:B94")
End Sub

引数 Type

• xlFillDefault : 標準のオートフィル
• xlFillCopy : セルのコピー
• xlFillSeries :　連続データ
• xlFillFormats : 書式のみコピー
• xlFillValues : 書式なしコピー
• xlFillDays : 日単位の連続データ
• xlFillWeekdays : 土日を除く平日の連続データ
• xlFillMonths : 月単位の連続データ
• xlFillYears : 年単位の連続データ
• xlLinearTrend : 加算("1,2"の続きは"3,4,5"になる)
• xlGrowthTrend : 乗算("1,2"の続きは"4,8,16"になる)

【セルの内容を消去】

Sub セルの内容を消去()
    ' 書式を消去
    Range("A90:B94").ClearFormats
    ' データを消去
    Range("A90:B94").ClearContents
    ' データと書式を消去
    Range("A90:B94").Clear
End Sub

【目的のセルを検索する】

Sub 会員検索()
    Range("B4:B18").Find(What:=Range("B22").Value, LookAt:=xlWhole).Select
End Sub

書式

• Rangeオブジェクト.Find(What, [After], [LookIn], [LookAt], [SearchOrder], [SearchDirection], [MatchCase], [MatchByte], [SearchFormat])
• 検索結果：Rangeオブジェクト

引数 LookIn

• xlFormulas : 数式
• xlValues : 値
• xlComments : コメント

引数 LookAt

• xlWhole : 完全一致
• xlPart : 部分一致

引数 SearchOrder

• xlByRows : 行方向
• xlByColumns : 列方向

引数 SearchDirection

• xlNext : 次へ(上から下、左から右)
• xlPrevious : 前へ(下から上、右から左)

引数 MatchCase

• True : アルファベットの大文字・小文字を区別して検索
• False : アルファベットの大文字・小文字を区別せずに検索

引数 MatchByte

• True : 文字の全角/半角を区別して検索
• False : 文字の全角/半角を区別せずに検索

引数 SearchFormat

• True : 書式の検索を行う
• False : 書式の検索を行わない

【票のデータを並び替える】

Sub 並び替え()
    Range("A3").Sort _
        Key1:=Range("F3"), Order1:=xlAscending, _
        Key2:=Range("C3"), Order2:=xlDescending, _
        Header:=xlYes
End Sub

書式

• Rangeオブジェクト.Sort([Key1], [Order1], [Key2], [Type], [Order2], [Key3], [Order3], [Header], [OrderCustom], [MatchCase], [Orientation], [SortMethod], [DataOption1], [DataOption2], [DataOption3])

引数 Key1, Key2, Key3

• Key1 : 並び替えの基準の列を項目名、またはRangeオブジェクトで指定する
• Key2 : 2番目に優先する並び替えの基準の列を項目名、またはRangeオブジェクトで指定する
• Key3 : 3番目に優先する並び替えの基準の列を項目名、またはRangeオブジェクトで指定する

引数 Order1, Order2, Order3

• Order1 : Key1で指定した並び替えの順序を指定する
• Order2 : Key2指定した並び替えの順序を指定する
• Order3 : Key3指定した並び替えの順序を指定する
• xlAscending　: 昇順
• xlDescending　: 降順

引数 Header

• xlGuess : Excelの判断に任せる
• xlNo : 先頭行は見出しではない
• xlYes : 先頭行は見出し

引数 MatchCase

• True : 大文字/小文字を区別する
• False : 大文字/小文字を区別しない

引数 Orientation

• xlSortRows: 行単位
• xlSortColumns : 列単位

引数 SortMethod

• xlPinYin: ふりがなを使う
• xlStroke : ふりがなを使わない

引数 Type

• 並べ替える要素を指定

引数 DataOption1(, DataOption2, DataOption3)

• Key1(, Key2, Key3) で指定した範囲でテキストを並べ替える方法を指定する

条件に一致するデータの抽出

Sub 条件に一致するデータの抽出()
    Range("A3").AutoFilter Field:=6, Criteria1:=">250"
    Range("A3").AutoFilter Field:=4, Criteria1:=">90"

    Range("A3").AutoFilter Field:=7, Criteria1:="技術部", _
        Operator:=xlOr, Criteria2:="総務部"
End Sub

AutoFilterメソッドで抽出した表を元に戻す

• Worksheetオブジェクト.AutoFilterMode = False

書式

• Rangeオブジェクト.AutoFilter([Field], [Criteria1], [Operator], [Criteria2], [VisibleDropDown])

引数

• Field : 条件を指定する列をを番号で指定する。表の左端の列から1,2,3と数える
• Criteria1 : 抽出条件を指定
• Operator: 抽出条件の種類を指定
• Criteria2 : 引数OperatorでAnd/Or条件を指定した場合に、2つ目の抽出条件を指定
• VisibleDropDown : Trueならフィルターボタンを表示。Falseなら表示しない。

引数 Operator

• xlAnd : AND条件
• xlOr : OR条件
• xlTop10Items: 大きい順に上からCriteria1番目までのデータ
• xlBottom10Items: 小さい順に上からCriteria1番目までのデータ
• xlTop10Percent: 大きい順に上からCriteria1%のデータ
• xlBottom10Percent: 小さい順に上からCriteria1%のデータ
• xlFilterCellColor: Criteria1で指定したセルの色
• xlFilterFontColor: Criteria1で指定したフォントの色

抽出条件の書式

• "=40" : 40に等しい
• "<>40" : 40と異なる
• ">40" : 40より大きい
• ">=40" : 40以上
• "<40" : 40より小さい
• "<=40" : 40以下
• "=" : 空白セル
• "<>" : 空白以外のセル

• "総務部" : 総務部
• "<>総務部" : 総務部以外
• "総務部*" : 総務部で始まる
• "*総務部" : 総務部で終わる
• "*総務部*" : 総務部を含む
• "<>*総務部*" : 総務部を含まない
• "???総務部" : 3文字+総務部
• "営業?課" : 営業+1文字+課 (営業1課など)

【セル内の文字の一部を指定】

Sub セル内の文字の一部を指定()
    Range("B1").Characters(4, 2).Font.Size = 18
    Range("B1").Characters(4, 2).Font.ColorIndex = 3
End Sub

【ワークシートの参照】

Sub ワークシートの参照()
     'ワークシート名の変更
    Worksheets(2).Name = "シート2"
    'ワークシートの情報を表示
    MsgBox "アクティブシート:" & ActiveSheet.Name & _
        Chr(13) & "2番目のシート:" & Worksheets(2).Name & _
        Chr(13) & "ワークシート数：" & Worksheets.Count & _
        Chr(13) & "末尾のシート:" & Worksheets(Worksheets.Count).Name
End Sub

Chr関数

• Chr(9) : タブ(次の基準位置へ)
• Chr(10) : ラインフィード(次の行へ)
• Chr(13) : キャリッジリターン(行頭へ)
• Chr(48) : 0
• Chr(65) : A
• Chr(97) : a

ワークシートの追加・削除

Sub ワークシートの追加()
    Worksheets.Add Before:=Worksheets(1)
    ActiveSheet.Name = "目次"
End Sub

Sub ワークシートの削除()
    '確認メッセージを非表示にしてから削除。その後、確認メッセージを有効に戻す
    Application.DisplayAlerts = False
    Worksheets("目次").Delete
    Application.DisplayAlerts = True
End Sub

Sub ワークシートの削除()
    Dim シート As Worksheet
    Dim 存在 As Boolean
    存在 = False
    For Each シート In Worksheets
        If シート.Name = "目次" Then
            存在 = True
        End If
    Next

    If 存在 = True Then
        '確認メッセージを非表示にしてから削除。その後、確認メッセージを有効に戻す
        Application.DisplayAlerts = False
        Worksheets("目次").Delete
        Application.DisplayAlerts = True
    Else
        MsgBox "目次シートは存在しません"
    End If
End Sub

Add書式

• Worksheetsコレクション.Add([Before], [After], [Count], [Type])

Add引数

• Before : 指定したワークシートの前(左)に追加される。
• After : 指定したワークシートの後ろ(右)に追加される。
• Count : 追加するワークシートの枚数(省略時は1枚)

ワークシートの移動・コピー・切り替え

Sub ワークシートの移動コピー切り替え()
    ' コピー
    Worksheets("目次").Copy After:=Worksheets("目次")
    ActiveSheet.Name = "目次2"
    ' 移動
    Worksheets("目次").Move After:=Worksheets("目次2")
    ' 他のファイルへコピー
    Worksheets("目次").Copy _
        Before:=Workbooks("集計.xlsx").Worksheets(1)
    ' 切り替え
    Worksheets("目次").Select
End Sub

Copy/Move書式

• Worksheetオブジェクト.Copy/Move([Before], [After])

Select書式

• オブジェクト.Select([Replace])
• 引数Replace : マクロ実行前に選択中のワークシートの選択を解除するかどうか。Trueで解除。

ブックの参照

Sub ブックの参照()
    MsgBox "最初に開いたブック名 : " & Workbooks(1).Name & Chr(13) & _
        "アクティブなブック : " & ActiveWorkbook.Name & Chr(13) & _
        "このマクロのブック : " & ThisWorkbook.Name
End Sub

ブックを開く

Sub ブックを開く()
    Workbooks.Open ThisWorkbook.Path & "\集計.xlsx"
End Sub

書式

• Workbooksコレクション.Open(FileName, [UpdateLinks], [ReadOnly], [Format], [Password], [WriteResPassword], [IgnoreReadOnlyRecommended], [Origin], [Delimiter], [Editable], [Notify], [Converter], [AddToMru], [Local], [CorruptLoad])

引数

• FileName : 開きたいブックの保存場所と名前を指定。
• UpdateLinks : ブック内にリンクが設定されている場合の更新方法を指定。
• ReadOnly : ブックを読み取り専用で開く場合はTrue。
• Format : テキストファイルを開く場合の区切り文字
• Password : 読み取りパスワードで保護されたブックを開くときのパスワードを指定
• WriteResPassword : 書き込みパスワードが設定されたブックを開くときのパスワードを指定
• IgnoreReadOnlyRecommended : 読み取り専用推奨メッセージを非表示にするならTrue
• Origin : テキストファイルを開くときの変換形式
• Delimiter : 引数Formatで6(カスタム文字)を指定した場合の区切り文字を指定

引数UpdateLinks

• 0 : リンクを更新しない
• 3 : リンクを更新する

引数Origin

• xlMacintosh : Macintosh
• xlMSDOS : MS-DOS
• xlWindows : Windows

引数Format

• 1 : タブ
• 2 : カンマ(,)
• 3 : スペース
• 4 : セミコロン(;)
• 5 : なし
• 6 : カスタム文字(引数Delimiterで指定)

ワークブックの保存、閉じる

Sub ブックを保存()
    ' 上書き保存
    ThisWorkbook.Worksheets(1).Range("D1").Value = Now
    ThisWorkbook.Save
   
    ' 保存
    On Error GoTo エラー処理
        Workbooks.Add
        ActiveWorkbook.Worksheets(1).Range("A1").Value = "売り上げ:" & Date
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\売上" & Format(Date, "mmdd")
       
        ' 閉じる
        ActiveWorkbook.Close
    Exit Sub
エラー処理:
    MsgBox Err.Description
End Sub

Add書式

• Workbooksコレクション.Add([Template])

Add引数Template

• xlWBATChart : グラフシート
• xlWBATExcel4IntlMacroSheet : Excel 4.0のインターナショナルマクロシート
• xlWBATExcel4MacroSheet :　Excel 4.0のマクロシート
• xlWBATWorksheet : ワークシート

指定フォルダの一覧作成

Sub 指定フォルダのファイル一覧作成()
    Dim ファイル As String
    Dim 番号 As Integer
    ファイル = Dir(ThisWorkbook.Path & "\*.xlsx")
    番号 = 1
    Do While ファイル <> ""
        Cells(番号, 1).Value = ファイル
        ファイル = Dir()
        番号 = 番号 + 1
    Loop
End Sub

ファイルの開閉でマクロを実行

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Range("D1").Value = Now
    ActiveWorkbook.Save
End Sub

Private Sub Workbook_Open()
    With Range("A1048576").End(xlUp).Offset(1)
        .Value = Format(Date, "m月d日")
        .Offset(, 1).Select
    End With
End Sub

備考

• イベントプロシージャを作成するには「ThisWorkbook」モジュールをダブルクリック。オブジェクトで「Workbook」を選択。プロシージャでOpen/BeforeCloseイベントを選ぶ。
• セルA1048576から上方向に終端のセルを探し、その1つ下を選択する。

印刷プレビュー、印刷

Sub 印刷実行()
    ' 印刷プレビュー
    ActiveSheet.PrintPreview
   
    ' 2部印刷
    ActiveSheet.PrintOut Copies:=2
End Sub

PrintPreview書式

• オブジェクト.PrintPreview([EnableChanges)]
• 引数EnableChanges : プレビュー字のページ設定の変更可否。Trueなら変更可能。

PrintOut書式

• オブジェクト.PrintOut([From], [To], [Copies], [Preview], [ActivePrinter], [PrintToFile], [Collate], [PrToFileName], [IgnorePrintAreas])
• 引数From : 印刷開始ページ
• 引数To : 印刷終了ページ
• 引数Copies : 印刷部数
• 引数Preview : Trueなら印刷プレビュー表示

マクロ処理高速化：処理中に画面の更新を止める

Sub 処理中に画面の更新を止める()
    Dim 回数 As Integer
    Application.ScreenUpdating = False
    For 回数 = 1 To 8
        Worksheets(1).Copy After:=ActiveSheet
        ActiveSheet.Name = 回数 & "回目"
    Next 回数
    Application.ScreenUpdating = True
End Sub

PDF出力

Sub PDF出力()
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=ThisWorkbook.Path & "\週間予定", _
        OpenAfterPublish:=True
End Sub

ExportAsFixedFormat 書式

• Worksheetオブジェクト.ExportAsFixedFormat(Type, [Filename], [Quality], [IncludeDocProperties], [IgnorePrintAreas], [From], [To], [OpenAfterPublish])
• 引数Type: 保存後のファイル形式
• 引数FileName : 保存するファイル名
• 引数Quality : ファイルの品質
• 引数IncludeDocProperties: ファイルのプロパティを含める場合はTrue
• 引数IgnorePrintAreas: 印刷範囲を無視する場合はTrue
• 引数OpenAfterPublish: 保存後にファイルを開いて表示する場合はTrue

引数 Type

• xlTypePDF : PDF形式
• xlTypeXPS : XPS形式

引数 Quality

• xlQualityMinimum : 最小限の品質
• xlQualityStandard : 標準品質

日付/時刻、数値を指定の表示形式にする

Sub 日付の表示書式を変換()
    MsgBox "現在時刻: " & Now
    Range("D1").Value = Date
    Range("E1").Value = Time
    ActiveSheet.Name = Format(Range("D1").Value, "yyyy-mm")
End Sub

Format書式

• Format(Expression, [Format], [FirstDayOfWeek], [FirstWeekOfYear])
• 引数Expression : 変換元となる日付、時刻、文字列や数値
• 引数Format: 定義済み書式、または、表示書式指定文字を使って表示形式を指定

定義済み書式

• General Number : 区切り記号無し : 例 1234567
• Percent : パーセント表示 : 例 123.45%
• Long Date : 日付の長い形 : 2012年6月10日

年月日から日付データを作成

Sub 日付データを作成()
    Dim 日付 As Date
    日付 = Range("D1").Value
    MsgBox "入金期限(翌々月10日):" & DateSerial(Year(日付), Month(日付) + 2, 10)
End Sub

書式

• DateSerial (Year, Month, Day)
• 引数Year : 年のデータ 100～9999
• 引数Month : 月のデータ 1～12。範囲外のDateSerial(2012,13,1)とすると2013/1/1に自動調整される。
• 引数Day : 日のデータ 1～31。範囲外のDateSerial(2012,2,0)とすると2012/1/31に自動調整される。前月の末日を作るのに使用できる

文字数カウント、切り出し

Sub 文字数カウントと切り出し()
    Dim 氏名 As String
    氏名 = Range("B10").Value
    MsgBox 氏名 & " の文字数 : " & Len(氏名) & Chr(13) & _
        "苗字 : " & Left(氏名, 2)
End Sub

日付/時刻を扱う主なVBA関数

• Hour(Time) : 指定した時刻から時を求める
• Minute(Time) : 指定した時刻から分を求める
• Second(Time) : 指定した時刻から秒を求める
• DateValue(Date) : 日付を表す文字列から日付を作成

文字を扱う主なVBA関数

• LCase(String) : アルファベットの大文字を小文字に変換
• RTrim(String) : 文字列の末尾のスペースを削除
• Left(String, Length) : 左側の文字をLength分取り出す
• Right(String, Length) : 右側の文字をLength分取り出す
• Mid(String, Start, [Length]) : 左側からStat番目の文字からLength分取り出す

その他の主なVBA関数

• Val(String) : 文字列の中から数値を取り出す
• IsDate(Expression) : データが日付に変換できるかどうか調べる
• Int(Number) : 指定した数値の整数部分を返す
• Round(Arg1, Arg2) : Arg1のArg2桁目を四捨五入した数値を返す。Arg2が0の場合は小数点第1位を四捨五入。

文字を置き換える

Sub 文字を置き換える()
    ' 名前の「売上」を「在庫」に変更
    Worksheets(2).Name = Replace(Worksheets(1).Name, "売上", "在庫")
    ' 名前の「売上」を削除
    Worksheets(3).Name = Replace(Worksheets(1).Name, "売上", "")
End Sub

書式

• Replace(Expression, Find, Replace, [Start], [Count], [Compare])
• 引数Expression : 置換する文字列を含む文字列
• 引数Find : 検索する文字列
• 引数Replace: 置換後の文字列
• 引数Start: 検索開始位置
• 引数Count: 置換する個数。省略時は-1ですべて置換
• 引数Compare: 比較モード。省略時はバイナリモード

引数Compare

• vbBinaryCompare : バイナリモードで比較。全角・半角、大文字/小文字、ひらがな/カタカナ、が区別される
• vbTextCompare : テキストモードで比較。全角・半角、大文字/小文字、ひらがな/カタカナ、が区別されない。例えば、Ｅｘｃｅｌ、EXCEL、Excelのいずれでも対象になる。

乱数発生

Sub 乱数発生()
    ' 乱数初期化
    Randomize
    ' XからYの間の整数で乱数発生させる場合は、Int((Y-X+1) * Rnd+X)とする。
    Range("E65").Value = Int(5 * Rnd + 1)
    Range("E66").Value = Int(5 * Rnd + 1)
    Range("E67").Value = Int(5 * Rnd + 1)
End Sub

Randomize書式

• Randomize[Number]
• 引数Number : 乱数初期化に使う数値や数式(シード値)。同じ値を指定すると同じ乱数になる。省略時はシステム時刻。

Rnd書式

• Rnd[Number]

Rnd　引数 Number

• 0より小さい値 : 常に同じ数値を返す
• 0より大きい数または省略 : 乱数系列の次の乱数を返す(0以上1未満)
• 0 : 直前に生成した乱数を返す

パソコンの情報を表示

Sub パソコンの情報を表示()
    MsgBox "ユーザー名 : " & Environ("username") & Chr(10) & _
        "コンピューター名 : " & Environ("computername") & Chr(10) & _
        "使用中のOS名: " & Environ("os") & Chr(10) & _
        "システムディレクトリ: " & Environ("windir") & Chr(10) & _
        "プライマリドライブ: " & Environ("homedrive") & Chr(10) & _
        "ユーザー用ディレクトリ: " & Environ("homepath")
End Sub

引数 Expression

• username : ユーザー名
• computername: コンピューター名
• date : 現在の日付
• time : 現在の時刻
• os : 使用しているOSの種類
• windir : システムディレクトリのパス
• homedrive: プライマリドライブ
• homepath: ユーザー用ディレクトリ

ワークシート関数の利用

Sub ワークシート関数の利用()
    Dim 合計 As Long
    合計 = Application.WorksheetFunction.Sum(Range("C58:C61"))
    MsgBox "合計金額 : " & 合計
End Sub

ワークシート関数を自作

Function 合否判定(英語 As Integer, 数学 As Integer, 国語 As Integer) As String
    If 英語 >= 60 And 数学 >= 50 And 国語 >= 70 Then
        合否判定 = "合格"
    Else
        合否判定 = "再試験"
    End If
End Function

備考

• 自作した関数はワークシートで数式として使える。"=合否判定(B1,C1,D1)"のように指定する。

図形選択

Sub 図形選択()
    ActiveSheet.Shapes(2).Select
End Sub

備考

• インデックス番号は「オブジェ宇都の選択と表示」を表示すると一覧表示される

新規入力行

Sub 新規入力行()
    With Range("A41").End(xlDown)
        .Offset(1).Value = .Value + 1
        .Offset(1, 1).Select
    End With
End Sub

会員検索

Sub 会員検索()
    Dim 該当セル As Range
    Set 該当セル = Range("B49:B53").Find _
        (What:=Range("H49").Value, LookAt:=xlWhole)
    If 該当セル Is Nothing Then
        MsgBox "該当者が見つかりません。"
        Range("H52").ClearContents
    Else
        Range("H52").Value = 該当セル.Offset(0, 4).Value
    End If
    Set 該当セル = Nothing
End Sub

データ個別化

Sub データ個別化()
    Dim 行 As Integer
    Dim 列 As Integer
    Dim 番号 As Integer
    番号 = 2
    For 行 = 4 To 11
        For 列 = 2 To 7
            If Cells(行, 列).Value <> "" Then
                Cells(行, 列).Copy Worksheets("メンバー別").Cells(番号, 1)
                Cells(行, 1).Copy Worksheets("メンバー別").Cells(番号, 2)
                番号 = 番号 + 1
            End If
        Next
    Next
    Worksheets("メンバー別").Select
End Sub

備考

• サンプルファイル : data_by_group.xlsm

中身の文字ごとセルを結合する

Sub 文字ごとセル結合()
    Dim セル As Range
    Dim 文字列 As String
    文字列 = ""
    For Each セル In Selection
        文字列 = 文字列 & セル.Value
    Next
   
    With Selection
        .ClearContents
        .MergeCells = True
        .Value = 文字列
        .HorizontalAlignment = xlCenter
    End With
End Sub

備考

• サンプルファイル : merge_cell_with_string.xlsm

指定条件の会員削除

Sub 退会者削除()
    Dim 先頭行 As Long
    Dim 末尾行 As Long
    Dim 行番号 As Long
    先頭行 = 4
    ' 末尾業を取得
    末尾行 = Range("A3").CurrentRegion.Rows.Count + 2
    ' 下から上へ確認しながらDeleteメソッドで削除
    For 行番号 = 末尾行 To 先頭行 Step -1
        If Cells(行番号, 4).Value = "退会" Then
            Rows(行番号).Delete
        End If
    Next
End Sub

備考

• 削除しても行番号がずれないように下から削除していく

備考

• サンプルファイル : delete_member.xlsm

表から数値データだけをクリアする

Sub 数値クリア()
    On Error GoTo エラー処理
    Dim ボタン As Integer
    ボタン = MsgBox("データをリセットします。", _
        vbExclamation + vbYesNo, "リセット確認")
    If ボタン = vbYes Then
        Range("A3").CurrentRegion. _
            SpecialCells(xlCellTypeConstants, xlNumbers) _
            .ClearContents
    End If
    Exit Sub
エラー処理:
    MsgBox Err.Description
End Sub

備考

• サンプルファイル : clear_values_only.xlsm

実行時間の測定

Dim Start, Finish As Variant
Start = Time
'処理
Finish = Time
MsgBox "取得が完了しました" & vbLf & "実行時間は" & _
   Format(Finish - Start, "nn分ss秒") & "でした"

画面の再描画、自動計算の停止と再開

'画面の再描画/自動計算を停止
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'処理
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

ファイルが存在しなければファイルダイアログを開く

Dim strPath As String
If Dir(ファイルパス) = "" Then
   With Application.FileDialog(msoFileDialogFilePicker)
      .Title = "ファイルを選択してください"
      .AllowMultiSelect = False
      .Show       strPath = .SelectedItems(1) '選択したファイルのパス
   End With
End If

Accessデータベースに接続する

Dim adoCn As Object
Set adoCn = CreateObject("ADODB.Connection")
adoCn.Open _
   "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
   ThisWorkbook.Path & "\test.accdb;"

On Error Goto Catch
adoCn.BeginTrans 'トランザクション開始

'処理

adoCn.CommitTrans '確定処理をしてトランザクション終了
adoCn.Close: Set adoCn = Nothing
Exit Sub

Catch:
'キャンセル処理をしてトランザクション終了
adoCn.RollbackTrans
'コネクションのクローズと破棄
adoCn.Close: Set adoCn = Nothing

PowerPointファイルを開く

Dim ppApp As New PowerPoint.Application
ppApp.Visible = True

Dim ppPrs As PowerPoint.Presentation
Set ppPrs = ppApp.Presentation.Open(ThisWorkbook.Path & _
   "\ひな形.pptx")

'処理

ppApp.Quit
Set ppApp = Nothing

InternetExplorerでURLを開く

Dim objIE As InternetExplorer
Set objIE = CreateObject("Internetexplorer.Application")

objIE.Visible = True
objIE.navigate "http://www.google.co.jp"

Do While objIE.Busy = True Or _
   objIE.readState < READYSTATE_COMPLETE '読み込み待ち
   DoEvents
Loop

Dim htmlDoc As HTMLDocument
Set htmlDoc = objIE.HTMLDocument

'処理

objIE.Visible = False
Set objIE = Nothing

フィールド名を列挙型として宣言

Enum CPref '列番号を列挙型として宣言
   都道府県名 = 1
   都道府県庁所在地
   人口
   面積
End Enum

Sub printPref()
Dim i As Long
i = 2
With ThisWorkbook.Worksheets("Sheet2")
   Do While .Cells(i, cPref.都道府県名).Value >< ""
      '列番号を列挙型を利用して指定
      Debug.Print _
         .Cells(i, cPref.都道府県名).Value, _
         .Cells(i, cPref.人口).VALUE
      i = i + 1
   Loop
End With

End Sub

表の最後の行番号を取得する

Worksheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row

相対参照の関数・数式の入力

Range("F18:F12").FormulaR1C12 = "R[0]C[02]*R[0]C[-1]"

日付値から曜日の文字列を得る

MsgBox Format(#1/1/2018#, "aaaa")

西暦：yyyy, yy
和暦：ggge, gge, ge
曜日：aaaa, aaa
月：m,mm
日：d,dd
時：分：秒：hh:mm:sなど

Range("C4").Value = IIf( _
   Application.WorksheetFunction.NetworkDays_Intl( _
   Range("C2").Value, Range("C2").Value, "0010011"), _
   "出勤日", "休日")

列内で参照式がずれているセルに色をつける

Dim i
For i = 2 To Selection.Count
   If Selection.Cells(i).FormulaR1C1 <> ActiveCell.FormulaR1C1 Then
      Selection.Cells(i).Interior.Color = rgbYellow
   End If
Next

よく使う表のパターンをマクロでコピーする

'表を見出しを除く範囲を選択
With Range("B2").CurrentRegion
   .Rows("2:" & .Rows.Count).Select
End With

無記名のコメントを作成する

With ActiveCell.AddComment
   .Text Text:=""
   .Visible = True
End With

重複するセルを削除する

Selection.RemoveDuplicate 1, xlYes

数式の入力されているセルのみ文字色を設定する

Range("D3:F7").SpecialCells(xlCellTypeFormulas).Font.ThemeColor = 9

アクティブシートのフォーム以外の図形を一括削除

Dim shp
For Each shp In ActiveSheet.Shapes
   If shp.Type <> msoFormControl Then shp.Delete
Next

図中の文字列を縦横中央に配置する

With ActiveSheet.Shapes("吹き出し：四角形1").TextFrame2
   .VerticalAnchor = msoAnchorMiddle
   .HorizontalAnchor = msoAnchorCenter
End With

吹き出し内のテキストを変更する

ActiveSheet.Shapes("吹き出し1").TextFrame2.TextRange _
   .Text = Format(Now, "hh:mm") & "時点での各商品販売数です"

グラフ・図形の位置や大きさを調整する

Dim rng
Set rng = Range("E2:I10")
With ActiveSheet.ChartObjects("グラフ1")
   .Top = rng.Top
   .Left = rng.Left
   .Width = rng.Width
   .Height = rng.Height
End With

定番のグラフを作成する

Dim rng
Set rng = Range("F2:J13")
With ActiveSheet.Shapes.AddChart2( _
   -1, xlColumnClustered, _
   rng.Left, rng.Top, rng.Width, rng.Height).Chart
   '元データの範囲を更新
   .SetSourceData Range("B2:D5")
   '「前月比」の列のデータを第２軸として設定
   .SeriesCollection("前月比").AxisGroup = xlSecondary
   .SeriesCollection("前月比").ChartType = xlLine
   '凡例の表示宇位置を上端に設定
   .SetElement(msoElementLegendTop)
   '色の設定
   .ChartColor = 26
   'タイトルの設定
   .ChartTitle.Text = "得点一覧"
End With

重複を取り除いたリストを作成する

Range("C2:C12").AdvancedFilter _
   Action := xlFilterCopy, _
   CopyToRange := Range("G2"), Unique := True

特定の値を持つセルに色を付ける

'値を指定する場合
Range("C3:G7").FormatConditions.Add( _
   Type := xlTextString, TextOperetor := xlContains, _
   String := "Excel" _
).Interiror.ThemeColor = xlThemeColorAccent4

'条件に数式を用いる場合
Range("B2:F6").FormatConditions.Add( _
   Type := xlExpression, Formula1 := "=ISTEXT(B2)" _
).Interiror.ThemeColor = xlThemeColorAccent4

フィルターの結果を転記する

Dim sht
Set sht = Worksheets.Add
sht.Name = "結果"
sht.Move After:=Worksheets(Worksheets.Count)
With Worksheets(1).Range("B2:F2").CurrentRegion
   .AutoFilter Field:=3, Criteria1:="山田太郎"
   .Copy
   sht.Range("B2").PasteSpecial xlPasteColumnWidths
   sht.Range("B2").PasteSpecial xlPasteAll
   .AutoFilter
End With

抽出したデータのみのスポット集計を行う

With Application.WorksheetFunction
   MsgBox "個数：" & .Subtotal(2, Columns("E")) & vbLf & _
      "合計：" & .Subtotal(9, Columns("E"))
End With

コメントの位置と内容を一覧表にまとめる

Application.Goto Worksheets("コメント整理").Range("B3")
Dim rng
For Each rng In Worksheets(1).Cells.SpecialCells(xlCellTypeComments)
   ActiveCell.Value = rng.Address
   ActiveCell.Offset(0, 1).Value = Replace(rng.Comment.Text, vbLf, "")
   ActiveCell.Offset(1).Select
Next

グラフを画像として書き出す

ActiveSheet.ChartObjects(1).Chart.Export _
   ThisWorkbook.Path & "\グラフ画像.png"

日付を付けてコピーを保持する

Dim bkName
bkName = Split(ThisWorkbook.Name, ".")(0) & Format(Now, "_yyyymmdd")
ThisWorkbook.SaveCopyAs ThisWorkbook.Path & _ "\バックアップ\" & bkName & ".xlsm"

保存用フォルダーが無い場合に作成する

Dim fldPath
fldPath = ThisWorkbook.Path & "\保存用"
If Dir(fldPath, vbDirectory) = "" Then MkDir fldPath

大きな表をA3用紙１枚に収まるように印刷する

With ActiveSheet.PageSetup
   .PaperSize = xlPaperA3
   .Orientation = xlPortrait
   .Zoom = False
   .FitToPagesWide = 1
   .FitToPagesTail = 1
End With

マクロをショートカットキーに登録する

'[Ctrl]+[Shift]+[C]キーでマクロ「資料をスナップ」を実行
Application.OnKey "+^{C}", "資料をスナップ"
'[Ctrl]+[Shift]+[C]キーでマクロ「資料をスナップ」を解除
Application.OnKey "+^{C}"

Shift : ^
Ctrl : +
Alt : %
キーボードのキー : {文字}

複数シートをまとめて選択する

Worksheets(Array("本店", "神奈川", "名古屋")).Select

すべてのシートのセルA1を選択して保存する

Dim i
For i = ActiveWorkbook.Worksheets.Count To 1 Step -1
   Application.Goto ActiveWorkbook.Worksheets(i).Range("A1")
Next
ActiveWorkbook.Save

数式が入力されているセルだけを保護する

With ActiveSheet
   .UsedRange.SpecialCells(xlCellTypeConstants).Locked = False
   .Protect
End With

ブックに保存されている個人情報を消去する

ActiveWorkbook.RemovePersonalInformation = True

非表示シートがあるかどうかをチェックする

Dim sht
For Each sht In Worksheets
   If sht.Visible <> xlSheetVisible Then
      sht.Visible = xlSheetVisible
      MsgBox "非表示だったシート名：" & sht.Name
   End If
Next

現在のブックのフォルダーを開く

CreateObject("WScript.Shell").Run "C:\excel"
CreateObject("WScript.Shell").Run ActiveWorkbook.Path

個人用マクロブックのあるフォルダーを開く

CreateObject("WScript.Shell").Run Workbooks("PERSONAL.XLSB").Path

画面のちらつきやイベント処理を抑えて高速化する

Application.ScreenUpdating = False
With Workbooks.Open(ThisWorkbook.Path & "\本店.xlsx")
   .Worksheets(1).Range("B3:F8").Copy ThisWorkbook.Worksheets(1).Range("B3")
   .Close
End With
Application.ScreenUpdating = True

ボタンに登録するマクロを切り替える

Sub マクロA()
   Range("B2:D10").AutoFilter 1, ActiveCell.Value
   With ActiveSheet.Shapes("ボタン１")
      .TextFrame.Characters.Text = "フィルター解除"
      .OnAction = "マクロB"
   End With
End Sub

Sub マクロB()
   ActiveSheet.AutoFilterMode = False
   With ActiveSheet.Shapes("ボタン1")
      .TextFrame.Characters.Text = "選択セルの値のフィルター"
      .OnAction = "マクロA"
   End With
End Sub

ブラウザーで任意のページを開く

CreateObject("Wscript.Shell").Run "https://google.jp/"

指定時間や一定の間隔でマクロを実行する

Sub マクロを予約実行()
   Application.OnTime Now + TimeValue("0:00:05"), "メッセージ表示"
   Range("B6").Value = "実行待機中"
End Sub

Sub メッセージ表示()
   Range("B6").Value = "実行完了"
   MsgBox "予約時間になりました"
End Sub

【参考ページ】

【参考図書】