個人用マクロブックのすすめ～実践編～

(2019.12.02追記)ウチが書いている他のマクロ記事を冒頭に載せました。

---

もっとはじめに

Excelマクロ関連の記事他にもありますので、よかったら併せてみてもらえるとうれしいです。

• Excelファイル加工に関するマクロTips
  • Excelファイル加工に使えそうなネタをまとめてます
• 個人用マクロブックのすすめ～入門編～
  • 個人用マクロブックの作成やVBA Editorの使い方の紹介

はじめに

当記事は実際にウチが使っているマクロをまとめております。
そもそも個人用マクロブックがよくわからない方は上の記事を参照いただけたらと思います。

どんな人向け？

• 個人用マクロブックの使い方を知っている人
• 他の人が個人用マクロブックに何入れているのか知りたい

ウチの個人用マクロ

一例ということで自分の個人用マクロブックにはいっているマクロを紹介します。
※一部ネットからコピペして使っているものは除外し、参考URLで紹介します。

保存前に全シートを整える

職場によっては「Excelは全シートA1を選択」だったり「ページレイアウトは標準固定」とか「ページ倍率全て統一」とか礼儀？　風習があると思います。
数ページ程度だと問題ないですが、十数ページになるとさすがに面倒なのでマクロにしました。

全シート、以下を整えます。
(任意)となっている項目については、設定しなければ元のままです。

• A1セルを選択
• スクロールバーを左上に
• (任意)表示形式(標準、改ページ、レイアウト)
• (任意)セルの目盛りの有無
• (任意)表示倍率

思えばこれが初めて作ったマクロでした。

保存前に全シートを揃える

Option Explicit

Sub a01_保存前に全シート整える()

'変数宣言 - - - - - - - - - -

'ブックの表示形式
Dim book_visual As String

'セル目盛線
Dim cell_guridline As String

'拡大倍率
Dim zoom_value As String

'一時変数
Dim i As Integer


'処理 - - - - - - - - - -

'画面描写無効
Application.ScreenUpdating = False

'全シートの表示形式をどうするか
book_visual = InputBox("標準？　レイアウト？　改ページ？", "キャンセルでそのまま", "")

'何も入れなかったら倍率そのまま
If book_visual = "" Then

'それぞれの値なら、それぞれの値を格納
ElseIf book_visual = "標準" Then
    book_visual = xlNormalView

ElseIf book_visual = "レイアウト" Then
    book_visual = xlPageLayoutView

ElseIf book_visual = "改ページ" Then
    book_visual = xlPageBreakPreview

'想定外の文字が入力された場合終了
Else
    MsgBox ("標準、レイアウト、改ページだけ入れて")
    Exit Sub

End If


'全シートの目盛り表示どうする？
cell_guridline = InputBox("目盛り入れる？　いれない？(on or off)", "キャンセルでそのまま", "")

'何も入れなかったら倍率そのまま
If cell_guridline = "" Then

'それぞれの値なら、それぞれの値を格納

ElseIf cell_guridline = "on" Then
    cell_guridline = True

ElseIf cell_guridline = "off" Then
    cell_guridline = False

'想定外の文字が入力された場合終了
Else
    MsgBox ("on、offだけ入れて")
    Exit Sub

End If

'全シートの表示倍率をどうするか？
zoom_value = InputBox("表示倍率どうする？", "キャンセルでそのまま", "")

'何も入れなかったら倍率そのまま
    If zoom_value = "" Then

'数字以外の値の場合終了
ElseIf IsNumeric(zoom_value) = False Then

    MsgBox ("数字だけ入れて")
    Exit Sub

'10～400外の倍率は表示できないので終了
ElseIf zoom_value < 10 Or 400 < zoom_value Then

    MsgBox ("その倍率は無理！　10～400で！")
    Exit Sub

End If

'アクティブブックの全シートに対して繰り返し処理
For i = 1 To ActiveWorkbook.Worksheets.Count

    'i番目のシートをアクティブに
    Worksheets(i).Activate

    'A1を選択
    ActiveWorkbook.Worksheets(i).Range("A1").Select

    'スクロールバーを左上に
    ActiveWindow.ScrollRow = ActiveCell.Row
    ActiveWindow.ScrollColumn = ActiveCell.Column

    '表示形式を指定してるならその通りに倍率調整
    If book_visual <> "" Then
        ActiveWindow.View = book_visual
    End If

    '目盛表示を指定しているならその通りにメモリ表示
    If cell_guridline <> "" Then
        ActiveWindow.DisplayGridlines = cell_guridline
    End If

    '表示倍率を指定してるならその通りに倍率調整
    If zoom_value <> "" Then
        ActiveWindow.Zoom = zoom_value
    End If

Next i

'最初のシートを表示
Worksheets(1).Activate

'「保存して閉じる」をしたいなら以下2行を非コメント化
'ActiveWorkbook.Save
'ActiveWorkbook.Close

'画面描写有効
Application.ScreenUpdating = True

End Sub

フォルダ内のファイル書き出し

大量の機器コンフィグをExcelファイルに貼り付けて資料にすることが多かったため、作ったマクロです。
マクロを実行すると、対象フォルダの選択を行い、1シートにまとめるかシート毎に出力するか選択すると、テキストファイルの書き出しが行われます。

印刷設定が入っているのは、前の職場が証跡を紙媒体で保管することが多かった名残です。

ちなみに、★マークがついているbuf = Replace(.ReadAll, vbCr & vbCrLf, vbCrLf)はログ取得時に改行コードがCR、CRLFが重なって出力されていたのでCRLF1つに置換する処理です。
使う環境によって、コメントアウトして使ってください。

Option Explicit

Sub a03_フォルダ内のファイル書き出し()

'変数宣言 - - - - - - - - - -

'入力ファイル格納フォルダ
Dim import_folder As String

'入力ファイル
Dim import_file As String

'出力先用ポインター
'input_pointer : 書き込む行、input_start_pointer：最初に書き込んだ行
Dim input_start_pointer As Double
Dim input_pointer As Double

'一時変数(文字列をsplitして配列化するのでVariant)
Dim buf As Variant

'一時変数(for用)
Dim i As Double


'処理 - - - - - - - - - -

'画面描写無効
Application.ScreenUpdating = False

'ファイル格納フォルダを指定
If Application.FileDialog(msoFileDialogFolderPicker).show = True Then

    import_folder = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)

End If

'フォルダを何も指定しなかったら終了
If import_folder = "" Then

    MsgBox ("フォルダが選択されていないので終了"): Exit Sub

End If

'ファイルパス取得
import_file = Dir(import_folder & "\*")

'新しいexcelファイル生成
Workbooks.Add

'出力形式は1シートにまとめる場合は空エンター
'1シートごとに分けるならなにか入力してエンター
If InputBox("出力方法(空エンターで1シートまとめ" & vbCrLf & "何か入力すればシート分け)") = "" Then

    'シート初期設定マクロ呼出し
    Call a03_01_シート初期設定

    '書き出し行初期化
    input_pointer = 0

    'インポートファイルなくなるまで繰り返す
    Do While import_file <> ""

        '3つ下にポインターをシフト
        input_pointer = input_pointer + 2

        'インデックスセルの行数指定
        input_start_pointer = input_pointer - 1

        'ファイル書き出しマクロ呼出し
        input_pointer = a03_02_ファイル書き出し(input_pointer, 2, import_folder, import_file)

        '1ファイル分行をグループ化
        Call Rows(input_start_pointer + 2 & ":" & input_pointer).Group

        '次のファイルを探索
        import_file = Dir()

    Loop

'1シート毎に書き出す
Else

    'テキストファイル⇒Excelへ出力
    Do While import_file <> ""

        'シート初期設定マクロ呼出し
        Call a03_01_シート初期設定

        'シート名変更(30字以内ならファイル名をそのままシート名にする)
        If Len(import_file) <= 30 Then

            ActiveSheet.name = import_file

        '30文字より長い場合、シートインデックス番号を追加して省略する
        '※シート名重複防止
        Else

            ActiveSheet.name = ActiveSheet.Index & "_" & Left(import_file, 29 - Len(ActiveSheet.Index))

        End If

        'ポインター初期化
        input_pointer = 3

        'ファイル書き出しマクロ呼出し
        input_pointer = a03_02_ファイル書き出し(input_pointer, 2, import_folder, import_file)

        '次のファイルを探索
        import_file = Dir()

        'シートの新規作成
        If import_file <> "" Then Worksheets.Add After:=ActiveSheet

    Loop

End If

'アニメーション有効
Application.ScreenUpdating = True

End Sub


Function a03_01_シート初期設定()

'全セルに対し書式設定
With Cells
    '左寄せ
    .HorizontalAlignment = xlLeft

    'フォント指定
    .Font.name = "ＭＳ ゴシック"
    .Font.Size = 10

    'フォントの表示設定(文字列)
    .NumberFormatLocal = "@"

End With

'A列は余白
Columns("A:A").ColumnWidth = 1.63

'B列は書き出し行
Columns("B:B").ColumnWidth = 129.38

'対象シートの印刷設定
With ActiveSheet.PageSetup
    'ヘッダー
    .CenterHeader = "&A"

    'フッター
    .CenterFooter = "&P / &N"

    '印刷時の拡大率無効
    .Zoom = False

    '横方向1ページで印刷
    .FitToPagesWide = 1

    '縦方向指定なし
    .FitToPagesTall = False

End With

End Function


Function a03_02_ファイル書き出し(input_start_pointer As Double, column_num As Double, import_folder As String, import_file As String)

Dim buf As Variant
Dim i As Double

Dim input_pointer As Double

input_pointer = input_start_pointer + 1

'テキストファイルを一括読み込み
With CreateObject("Scripting.FileSystemObject")
    With .GetFile(import_folder & "\" & import_file).OpenAsTextStream

        'vbCrとvbCrLfが連続しているものはvbCrLfに置換　- - - - ★
        buf = Replace(.ReadAll, vbCr & vbCrLf, vbCrLf)
        .Close

    End With
End With

'vbCrLfで文字列を分割
buf = Split(buf, vbCrLf)

'分割した個数分、繰り返す
For i = 0 To UBound(buf)

    'Excelに分割した文字を貼り付け　※右側のスペースは削除
    Cells(input_pointer, column_num).Value = RTrim(buf(i))

    '1つ下にポインターをシフト
    input_pointer = input_pointer + 1

Next i

'1ファイル分書き出し終わったら1つ下にポインターをシフト
input_pointer = input_pointer - 1


'インデックスセル加工
Call a03_03_インデックスセル加工(input_start_pointer, input_pointer, column_num, import_file)

a03_02_ファイル書き出し = input_pointer

End Function


Function a03_03_インデックスセル加工(row_start_num As Double, row_end_num As Double, column_num As Double, cell_value As String)

'インデックスセルに対して
With Cells(row_start_num, column_num)

    'セルに値入力
    .Value = cell_value

    '罫線設定(全ての罫線を引く)
    .Borders.LineStyle = xlContinuous

    '罫線の太さをMedium
    .Borders.Weight = xlMedium

    'セル色設定(水色)
    .Interior.ColorIndex = 8

End With

'書き出したセルに対して
With Range(Cells(row_start_num + 1, column_num), Cells(row_end_num, column_num))

    '罫線設定(全ての罫線を引く)
    .Borders.LineStyle = xlContinuous

    '罫線の太さをMedium
    .Borders.Weight = xlMedium

    '中の罫線は全て除く
    .Borders(xlInsideHorizontal).LineStyle = xlNone

End With

End Function

列と列の差分チェック

比較したい2列があったとき、2列並べて右に=if(xx=xx,"○","")と毎回打つのも面倒ですし、どこの箇所に差異があるかひと目で分かるようにするために作りました。

インプットボックスでどの2列か、どこからチェックするか指定できます。
デフォルトはA列とB列を1行目からチェックしてくれます。

チェック後、差異がある行を黄色セルにし、差異がある文字を赤字に変えてくれます。

Option Explicit

Sub a04_列と列の差分チェック()

'変数宣言 - - - - - - - - - -

'チェック列①の列番号　※デフォルト1
Dim old_column As Variant

'チェック列②の列番号 ※デフォルト2
Dim new_column As Variant

'チェック開始行　※デフォルト1
Dim check_start_row As String

'チェック列①の最終行
Dim old_row_max As Double

'チェック列②の最終行
Dim new_row_max As Double

'チェック列①、②の最大最終行
Dim all_row_max As Double

'チェック列①の文字列数
Dim old_word_count As Double

'チェック列②の文字列数
Dim new_word_count As Double

'チェック列①、②の最小文字列数
Dim all_word_count As Double


'チェック列①のチェック文字列数


'一時変数
Dim i As Double
Dim j As Double

'処理 - - - - - - - - - -

'チェック列①の列番号指定
old_column = InputBox("一つ目の列は何列目(数字)？", "何も入力無しで1列目(A列)")

'何も入力してなければデフォルト1
If old_column = "" Then

    old_column = 1

'数字以外だったら終了
ElseIf IsNumeric(old_column) = False Then

    MsgBox ("数字のみ入力"): Exit Sub

End If

'数字化
old_column = old_column * 1


'チェック列②の列番号指定
new_column = InputBox("二つ目の列は何列目(数字)？", "何も入力無しで2列目(B列)")

'何も入力してなければデフォルト2
If new_column = "" Then

    new_column = 2

'数字以外だったら終了
ElseIf IsNumeric(new_column) = False Then

    MsgBox ("数字のみ入力"): Exit Sub

End If

'数字化
new_column = new_column * 1


'何行目からチェックするか指定
check_start_row = InputBox("何行目から開始？", "何も入力無しで1行目")

'何も入力してなければデフォルト1
If check_start_row = "" Then

    check_start_row = 1

'数字以外だったら終了
ElseIf IsNumeric(check_start_row) = False Then

    MsgBox ("数字のみ入力"): Exit Sub

End If

'数字化
check_start_row = check_start_row * 1


'チェック列①の最終行取得
old_row_max = Cells(1048576, old_column).End(xlUp).Offset(0).Row

'チェック列②の最終行取得
new_row_max = Cells(1048576, new_column).End(xlUp).Offset(0).Row

'チェック列①、②で差がある場合はその旨メッセージ出力
If old_row_max < new_row_max Then

    MsgBox (old_column & "列目(" & old_row_max & ")より" & new_column & "列目(" & new_row_max & ")の方が行数多いです")

ElseIf old_row_max > new_row_max Then

    MsgBox (new_column & "列目(" & new_row_max & ")より" & old_column & "列目(" & old_row_max & ")の方が行数多いです")

End If

'チェック列①、②両方合わせた最終行を取得
all_row_max = WorksheetFunction.Max(old_row_max, new_row_max)

'チェック開始行から最終行まで繰り返す
For i = check_start_row To all_row_max

    'チェックした行で差分が会った場合
    If Cells(i, old_column).Value <> Cells(i, new_column).Value Then

        'セル色を黄色
        Cells(i, old_column).Interior.Color = 65535
        Cells(i, new_column).Interior.Color = 65535

        'チェック列①の文字数
        old_word_count = Len(Cells(i, old_column).Value)

        'チェック列②の文字数
        new_word_count = Len(Cells(i, new_column).Value)

        'チェック列①、②の文字数で小さい方を取得
        all_word_count = WorksheetFunction.Min(old_word_count, new_word_count)

        'チェック列①の方が文字数多い場合、余剰部分を赤文字
        If old_word_count > all_word_count Then Cells(i, old_column). _
        Characters(Start:=all_word_count + 1, Length:=old_word_count - all_word_count).Font.ColorIndex = 3

        'チェック列②の方が文字数多い場合、余剰部分を赤文字
        If new_word_count > all_word_count Then Cells(i, new_column). _
        Characters(Start:=all_word_count + 1, Length:=new_word_count - all_word_count).Font.ColorIndex = 3

        '1文字目からチェック列①、②共通部分まで繰り返す
        For j = 1 To all_word_count

            'j番目の文字が相違している場合、その文字を赤字
            If Right(Left(Cells(i, old_column).Value, j), 1) <> Right(Left(Cells(i, new_column).Value, j), 1) Then
                Cells(i, old_column).Characters(Start:=j, Length:=1).Font.ColorIndex = 3
                Cells(i, new_column).Characters(Start:=j, Length:=1).Font.ColorIndex = 3
            End If
        Next j
    End If
Next i

'メッセージ出力
MsgBox (all_row_max & "行分確認OK")

End Sub

選択範囲のセルを結合

Excelで表を作るとき、複数行をセル結合することがよくあるんですが標準のセル結合だと囲った範囲全て結合しますし、勝手に真ん中に寄せます。ありがた迷惑なことがだいたいですね。
こちらのマクロでは、縦方向か横方向に選択範囲内のセルを結合します。
また、結合幅の調整も可能です。

選択範囲のセルを結合

Option Explicit

Sub a05_選択範囲のセルを結合()

'変数宣言 - - - - - - - - - -

'結合方法
Dim join_method As Variant

'選択範囲セルの左上行
Dim select_lefttop_row As Double

'選択範囲セルの左上列
Dim select_lefttop_column As Double

'選択範囲セルの右下行
Dim select_rightdown_row As Double

'選択範囲セルの右下列
Dim select_rightdown_column As Double

'結合セル個数
Dim split_size As Variant

'一時変数
Dim i As Double


'処理 - - - - - - - - - -

'画面描写無効
Application.ScreenUpdating = False

'縦へ結合か、横へ結合か選択(デフォルト横)
join_method = InputBox("縦へ結合？　横へ結合？", "", "横")

'選択範囲セルの左上の行、列を取得
select_lefttop_row = Selection(1).Row
select_lefttop_column = Selection(1).Column

'選択範囲セルの右下の行、列を取得
select_rightdown_row = Selection(Selection.Count).Row
select_rightdown_column = Selection(Selection.Count).Column

'縦でも横でもない場合、終了
If join_method <> "縦" And join_method <> "横" Then
    MsgBox ("縦横どっちか入力(または空エンター)")
    Exit Sub

End If

'何セルずつ結合するか
split_size = InputBox("何セルずつ結合？", "", 1)

'数字以外だった場合終了
If IsNumeric(split_size) = False Then
    MsgBox ("数字だけ入れて")
    Exit Sub
End If

'選択範囲を結合解除
Selection.UnMerge

'縦の場合
If join_method = "縦" Then

    '左上の列から右下の列+1まで、split_size上乗せで繰り返す
    For i = select_lefttop_column To select_rightdown_column + 1 - split_size Step split_size

        '行を結合
        Range(Cells(select_lefttop_row, i), Cells(select_rightdown_row, i + split_size - 1)).Merge
    Next i

'横の場合
ElseIf join_method = "横" Then

    '左上の行から右下の行+1まで、split_size上乗せで繰り返す
    For i = select_lefttop_row To select_rightdown_row + 1 - split_size Step split_size

        '列を結合
        Range(Cells(i, select_lefttop_column), Cells(i + split_size - 1, select_rightdown_column)).Merge

    Next i

End If

'画面描写有効
Application.ScreenUpdating = True

End Sub

一括文字追加or削除

複数のセルに対して、先頭や末尾に同じ文字を入れたり、逆に○字数分削除したりすることが多かったので作ったマクロです。
対象セルに毎回F2→コピペ→エンター→シフト→F2・・・は面倒ですからね。

Option Explicit

Sub a09_選択箇所の前後に文字を追加or削除()


'変数宣言 - - - - - - - - - -

'処理選択(追加or削除)
Dim select_method As Variant

'先頭に追加する文字
Dim plus_word_forward As String

'末尾に追加する文字
Dim plus_word_backward As String

'先頭を削除する文字数
Dim erase_forward_length As Variant

'末尾を削除する文字数
Dim erase_backward_length As Variant

'空白セルへの処理フラグ
Dim flg_input_blankcell As String

'一時関数
Dim i As Double

'処理 - - - - - - - - - -

'追加か削除か選択
select_method = InputBox("追加は空ENTER、削除は何か入力", "", "")

'追加の場合
If select_method = "" Then

    '先頭に追加する文字
    plus_word_forward = InputBox("前に何を追加する？", "前に文字追加", "")

    '末尾に追加する文字
    plus_word_backward = InputBox("後ろに何を追加する？", "後ろに文字追加", "")

    '空白セルへの処理フラグ
    flg_input_blankcell = InputBox("空白セルにも文字を追加するか？" & vbCrLf & _
                          "するなら空エンター、スキップするならなにか入力")

    '選択しているセル全てに対して繰り返す
    For i = 1 To Selection.Count

        'セルがブランク、かつ空白セルへの処理フラグが立っている場合
        If Selection(i).Value <> "" Or flg_input_blankcell = "" Then

            'セルに対して先頭文字、末尾文字を追加して入力
            Selection(i).Value = plus_word_forward & Selection(i).Value & plus_word_backward

        End If

    Next i

'削除の場合
ElseIf select_method <> "" Then

    '先頭から削除する文字数
    erase_forward_length = InputBox("前を何文字削除？", "前を文字削除", 0)

    '数字以外の場合、終了
    If IsNumeric(erase_forward_length) = False Then

        MsgBox ("数字のみ入力")
        Exit Sub

    End If

    '数字化
    erase_forward_length = erase_forward_length * 1

    '末尾から削除する文字数
    erase_backward_length = InputBox("後ろを何文字削除？", "後ろを文字削除", 0)

    If IsNumeric(erase_backward_length) = False Then

        MsgBox ("数字のみ入力")
        Exit Sub

    End If

    '数字化
    erase_backward_length = erase_backward_length * 1

    '選択しているセル全てに対して繰り返す
    For i = 1 To Selection.Count

        '選択セル内の文字列が、削除文字数以上の場合
        If Len(Selection(i).Value) >= erase_forward_length + erase_backward_length Then

            '先頭の文字を削除
            Selection(i).Value = Right(Selection(i).Value, Len(Selection(i).Value) - erase_forward_length)

            '末尾の文字を削除
            Selection(i).Value = Left(Selection(i).Value, Len(Selection(i).Value) - erase_backward_length)

        End If
    Next i

End If

End Sub

該当文字列のみ着色

ログから対象文字列を検索するとき、「検索するついでに検索した文字列だけ着色してくれたらなぁ・・・」と思い作ったマクロです。
すべて検索からヒットしたセルを着色すると検索文字列以外も色がついてしまい、結局どことヒットしているのか分かりづらいことが多かったので。

選択したセル内の該当文字列のみ着色

Option Explicit

Sub a11_選択したセル内の該当文字列のみを赤色()

'変数宣言 - - - - - - - - - -

'着色文字列
Dim change_color_word As String

'一時変数
Dim i As Double
Dim j As Double

'検索対象文字列
Dim current_string As String

'検索文字列位置
Dim change_word_position As Double


'処理 - - - - - - - - - -

'検索対象文字列
change_color_word = InputBox("検索対象文字列", "", "")

'何も入力してなかったら終了
If change_color_word = "" Then

    MsgBox ("何も入力していないので終了")
    Exit Sub

End If

'選択セル全てに対して
For i = 1 To Selection.Count

    'i番目の選択セルに対して
    With Selection(i)

        '検索対象文字列を取得
        current_string = .Value

        '検索位置初期化
        j = 1

        '1つ目の検索文字列の位置を取得
        change_word_position = InStr(j, current_string, change_color_word)

        '検索文字列がなくなるまで繰り返し
        While change_word_position <> 0

            '検索文字列を着色
            .Characters(Start:=change_word_position, Length:=Len(change_color_word)).Font.ColorIndex = 3

            '検索対象位置を上書き(1行に複数ある場合の為)
            j = change_word_position + Len(change_color_word)

            'ヒットした文字の次位置から再度検索
            change_word_position = InStr(j, current_string, change_color_word)

        Wend

    End With

Next i

End Sub

特定のキーを無効化する

セルに値入力するのにF2キーを押すつもりがF1キー誤入力してヘルプが出てしまうことあるのではないでしょうか、あるんです。
F1キーをぶち抜く前にマクロで解決しましょう。

Sub auto_open()

Application.OnKey "{F1}", ""

End Sub

これコピペすればF1息しなくなるよ！だけだとおざなりなので解説です。
auto_openはブックが開いたら実行するモジュール名で、個人マクロブックはExcel起動と同時に開かれるので実質ずっとです。
Aplication.OnKeyで対象キーに対してショートカットを設定することができます。
もちろん何か別のマクロや処理を設定することもできますが、""にすることで何もしなくなる、つまりキーが息しなくなります。

F1キー以外にも、使わないのに他キーとよく押し間違えるものは追加してもいいと思います。

簡単なマクロをショートカットに登録して使う

Excelには色々なショートカットがありますが、全て使うことはあまりないと思います。
逆に、「あぁいうショートカットがあればなぁ」と思ったものがあれば、その処理をマクロにし、ショートカットキーに登録することで自分だけのショートカットキーを作ることが出来ます。

ショートカットキー割り当てる上でオススメなキーは以下を満たすキーかと思います。

• Ctrlキーと一緒に押しやすいキー
• 普段使わないショートカットキー

個人的にオススメな割り当てキーは以下のとおりです。
実業務でよく使うキーだったら他のキーを当たってください。

ショートカットキー	内容
Ctrl + j	ないはず
Ctrl + l	ないはず
Ctrl + k	ハイパーリンクの挿入
Ctrl + o	ブックを開く
Ctrl + i	斜体
Ctrl + m	ないはず
Ctrl + q	クイック分析の表示
Ctrl + d	下方向にコピー

ショートカットキーの登録は簡単で、マクロ画面のオプションより設定することが可能です。

ショートカット登録するのにオススメなマクロを自分のを用いて紹介したいと思います。

A1式⇔R1C1式の変換

そもそもA1式とR1C1式とは何かって話ですが早い話セルの列番号をアルファベットにするか数字にするかです。
詳細および手動設定方法は以下を参考にして頂けたらと思います。

• A1形式とR1C1形式の表記の違い。

資料作成しているとアルファベット表記が良かったり数字表記が良かったりと、なんだかんだ切り替える機会が多いです。
オプションからいちいち変更するのは面倒なのでマクロにしてショートカット登録してしまいましょう。
ちなみに、マクロ名にショートカットキー何使うか書いておくと引っ越ししたときにスムーズに割り当てることが出来るのでオススメです。

Sub s01_CtrlとJでA1式R1C1式入れ替え()

    If Application.ReferenceStyle = xlA1 Then
        ' A1 式だった場合は、R1C1式へ
        Application.ReferenceStyle = xlR1C1

    Else
        ' R1C1 式だった場合は、A1式へ
        Application.ReferenceStyle = xlA1

    End If

End Sub

セル、文字への色付け、無色化

文字色変えたいとき、標準のショートカットだと、Alt → H → F1 → カーソルキーﾀﾝﾀﾝﾀﾝ・・・と入力するキーが多いですね。
資料の内容チェックで同じ色でマーキングする場合はショートカット登録したほうがいいです。
ついでに、色を元に戻す(文字は黒、セルは無色)マクロも一緒に作るとなお便利です。

ちなみに以下のマクロでは色指定方法にSelection.Font.ColorIndexを用いてますが、もちろんRGB指定でも良いともいます。
ただウチは面倒なのでカラーインデックスをよく使います。

Sub s02_CtrlとLで色字ショートカット()

'黒文字
'Selection.Font.ColorIndex = 1

'白文字
'Selection.Font.ColorIndex = 2

'赤文字
Selection.Font.ColorIndex = 3

'黄文字
'Selection.Font.ColorIndex = 6

End Sub

Sub s03_CtrlとKで塗り潰しショートカット()

'黒塗りつぶし
'Selection.Interior.ColorIndex = 1

'白塗りつぶし
'Selection.Interior.ColorIndex = 2

'赤塗りつぶし
'Selection.Interior.ColorIndex = 3

'黄塗りつぶし
Selection.Interior.ColorIndex = 6

'グレー塗りつぶし
'Selection.Interior.ColorIndex = 16

End Sub

Sub s04_CtrlとOで色クリアショートカット()

'文字
    Selection.Font.Color = xlblack

'セル
    Selection.Interior.Color = xlNone


End Sub

個人用マクロブックの表示、非表示

個人用マクロブックはいつものExcelブックと同じ使い方が出来ます。
そしてExcel起動したらずっと開きっぱなしということなので、ToDoやメモ、リンク集として使うのも便利です。
これもやはり毎回ブックの表示非表示をするの面倒なのでマクロにしちゃいました。

Sub s05_CtrlとIで作業用ブック再表示()

    If Windows("personal.xlsb").Visible = True Then
        Windows("PERSONAL.xlsb").Visible = False

    Else
        Windows("PERSONAL.xlsb").Visible = True

    End If


End Sub

行の挿入、削除

いやそんなのいらなくない？と思うかもしれませんが個人的に一番使うマクロはこれです。
複数行に渡りセル結合されている部分に行を挿入しようとShift + Spaceで行選択すると、セル結合された行全体が選択されてしまうんですよね。
いちいち対象行を右クリック→行の挿入するのが面倒だったので作りました。

ちなみに、行ごとコピーした状態でマクロを実行するとコピーした行が挿入されます。
行削除マクロも併せて使うとなお良しです、ただしマクロは基本実行後にCtrl + zは効かないですし、でかいサイズのデータがクリップボードにある状態で挿入するとフリーズするので注意してください。

Sub s07_CtrlとQで行挿入()

    For i = 1 To Selection.Rows.Count

        ActiveCell.EntireRow.Insert

    Next i

End Sub

Sub s08_CtrlとDで行削除()

    For i = 1 To Selection.Rows.Count

        ActiveCell.EntireRow.Delete

    Next i

End Sub

おわりに

この記事を読んでいる方に、どれか1つぐらい「あ、これ便利やん」と思えるマクロがあればと思います。
とはいえ、きっとどこかしら使っててしっくりこないところもあると思うので、自分好みにカスタマイズして自分の仕事効率が上がるようなマクロを作ってみてください。
「(なんかの処理)　Excel マクロ」でGoogle先生に聞けばいくらでも出てくるのでそれをコピーして、自分なりにアレンジしてコードを理解していくとマクロでできることが広がると思います。