Excelマクロで業務改善？！(小まとめ集)

はじめに

・業務内で使用することの多い”Excel”！
　→Excelを使っていてこうなれば便利なのにな…という案をいくつかまとめて
　　ExcelVBAで作成してみました。

目次

１．入力更新日の自動入力
２．貼り付け時に自動でコピー元のフォーマットが反映されない
３．複数ブックでのセル値の一括置換
４．提出用資料作成
５．F1キー無効化
まとめ
参考資料

1.入力更新日の自動入力

処理概要

・Excelシート内で、入力更新日として日付が入力されているセル以外の場所でデータの更新・書き換えがあった場合、自動的に入力更新日が当日の日付に更新されるというもの

マクロ・実行サンプル

実行するシートと日付入力しているセルの変数宣言とその変数に対しての設定値入力↓
'''

Dim sheetname As String 'シート名
Dim cell As String      'セル座標

sheetname = "Sheet1"    '日付の入力シート指定
cell = "A1"             '日付の入力セル指定

'''
日付入力セル以外の場所で更新された場合↓の処理を実行する
'''

If Not (Target.Address(RowAbsolute:=False, ColumnAbsolute:=False) = cell _
And Sh.Name = sheetname) Then

     ThisWorkbook.Worksheets(sheetname).Range(cell).Value = Date
End If
End Sub

'''
更新前→　
更新後→　

2.貼り付け時に自動でコピー元のフォーマットが反映されない

処理概要

シート内でコピーをする際、Ctrl+vで張り付けた場合に貼り付け先にはコピー元のフォーマットで張り付けられるところを設定されたショートカットキー(Ctrl+Shift+v)での貼り付けを行うと、自動的にコピー元のフォーマットが反映されずに貼り付けができるというもの

マクロ・実行サンプル

貼り付け前→　

貼り付けを行った際にはコピー元となるセルのフォーマットがそのままの状態で貼り付けられるが、下記のソースでそのフォーマットを反映させないマクロを作成する
書式を反映させないように設定するソースコード
'''

Sub 書式を反映しない()  '両方できるようにしたもの
On Error Resume Next   'エラーがでないようにする

ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
    False, NoHTMLFormatting:=True                 'HTMLのフォーマットを反映しない

Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False  'excelのフォーマットを反映しない

End Sub

'''
上記マクロの内容を反映させるためのショートカットキーを設定するものを作成
'''

Sub ショートカットキーの設定()
Application.MacroOptions Macro:="書式を反映しない", ShortcutKey:="V"            'cttl+shift+vのショットカットを作成

End Sub

'''
これらのマクロを実行することによりCtrl+Shift+vでの貼り付けを行うと、
貼り付け後→　
コピー元のExcel・HTMLのフォーマットが反映されずに張り付けられる！

３．複数ブックでのセル値の一括置換

処理概要

ブックを開いた際に、一括置換のフォームが出されてそのフォーム内で置換前と後の文字列・変更したい複数ファイルのあるフォルダを指定することで一括で文字列置換が行えるというもの

マクロ・実行サンプル

マクロ実行のためのソース↓
'''

Private Sub Workbook_Open() ' ブックを開いたときにフォームを表示 '
main.Show
End Sub

Sub 選択したフォルダ内ファイルを一括置換()' ユーザーフォーム表示用 '
main.Show
End Sub



' フォルダ内のブックを一括置換 '
Private Sub CommandButton1_Click()

Dim folderPath As String
Dim fileName As String

' フォルダ選択をした後の処理 '

     ' ワークシートを定義 '
    Dim Worksheet As Worksheet

    ' 置換後の文字を定義 '
    Dim to_Replace_String As String
    toReplaceString = TextBox1.Value

    ' 置換前の文字を定義 '
    Dim destinationString As String
    destinationString = TextBox2.Value


    ' 両テキストボックスに値が入っていたら複数ワークシートを置換します '
    If TextBox1.Text = "" Or TextBox2.Text = "" Then
        MsgBox "テキストボックスが空です"
    Else
        If TextBox3.Value = "" Then
            MsgBox "フォルダが選択されていません"
        Else
            folderPath = TextBox3.Value

            ' フォルダの中に含まれるファイル(ブック)を取り出す '
            fileName = Dir(folderPath & "\" & "*xls*")

            ' ファイル(ブック)がなくなるまで繰り返す '
            Do While fileName <> ""
            Workbooks.Open folderPath + "\" & fileName

            If CheckBox1.Value = True Then
                ' 部分置換を含む置換 '
                For Each Worksheet In ActiveWorkbook.Worksheets
                    Worksheet.UsedRange.Replace What:=destinationString, Replacement:=toReplaceString, LookAt:=xlWhole
                    Worksheet.UsedRange.Replace What:=destinationString, Replacement:=toReplaceString, LookAt:=xlPart
                Next Worksheet
            Else
                ' 完全一致のみの置換 '
                For Each Worksheet In ActiveWorkbook.Worksheets
                    Worksheet.UsedRange.Replace What:=destinationString, Replacement:=toReplaceString, LookAt:=xlWhole
                Next Worksheet
             End If

              ' ブックを上書き保存して閉じる '
            Workbooks(Workbooks.Count).Save
            Workbooks(Workbooks.Count).Close
            fileName = Dir() '
            Loop
            MsgBox "置換完了しました"
        End If
    End If
    ' テキストボックスを空にする '
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
End Sub

' キャンセルボタン '
Private Sub CommandButton2_Click()
Me.Hide
End Sub

'フォルダ選択ボタン '
Private Sub CommandButton3_Click()
Dim Folder As Object

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "フォルダを選択"
    .AllowMultiSelect = False
    If .Show = -1 Then
        TextBox3.Value = .SelectedItems(1)
    Else
        Exit Sub
    End If
End With

End Sub

'''
上記マクロの実行により、Excelブックを開いた際に、
フォーム→
フォーム内の置換前に書き換えたい文字を、置換後に更新したい文字を入力し、
フォルダ選択の押下で一括置換したい複数ファイルが存在するフォルダを指定する
「置換」の押下で複数のファイルブック内で指定した文字の置換が行われる！

４．提出用資料作成

処理概要

Excelに対して保存を行い、さらにExcelで作成した資料を提出する際に確認が必要な以下の作業、
　・A1セルに移動
　・倍率を100％に固定
　・HGP教科書体に固定
　・文字サイズを10に固定
これらを全シートに適用させ、ブック内の１シート目に移動するというもの

マクロ・実行サンプル

資料作成時、マクロ実行前のExcelブックサンプル↓
Sheet1→
Sheet2→
実行するマクロのソース↓
'''

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim WB As Workbook
Set WB = ActiveWorkbook

Dim WS As Worksheet
For Each WS In WB.Worksheets
WS.Activate
' A1セルに移動
WS.Cells(1, 1).Select

' 倍率を100％
ActiveWindow.Zoom = 100

' 書式を固定
Cells.Font.Name = "HGP教科書体"

' 文字サイズを固定
Cells.Font.Size = 10
Next

WB.Worksheets(1).Activate
End Sub

'''
マクロ実行後のExcelブック表示↓
Sheet1→
Sheet2→
実行後のブックではSheet1の記載文字の書式が統一されて、各SheetのA1セルに移動。表示倍率も各Sheetともに100%に統一されている

４．F1キー無効化

処理概要

Excelブックを開いてF1キーを押すとヘルプウィンドウが開かれる。
その操作をマクロを利用して無効化させるというもの

マクロ・実行サンプル

準備１：マクロの保存先を変更し、記録終了を押下


準備２：Alt+F11で下記ウィンドウを開く。module1選択後、ソースを記述して保存。

'''

Sub auto_open()

Application.OnKey “{F1}”, “”    'F1キーを無効化

End Sub

'''
Excelブックを閉じる際に、「マクロブックを保存しますか？・・・」
というポップアップ表示がされる。
その際に、保存をして閉じれば以降Excelブックを開いた際にはF1無効化のマクロが有効となっている為にヘルプウィンドウは起動されない。

まとめ

今回は、普段業務の中でExcelを使っていて面倒だな…こうなればいいな…という意見を持ち寄り、実現できそうなものをマクロを使って作成してみよう！というところから小さな業務改善になればといくつかのマクロ作成・実行を行い、まとめてみました！！

参考資料

２．貼り付け時に自動でコピー元のフォーマットが反映されない
・[ VBA ] エラーを無視して処理を継続する
・マクロにショートカットキーを設定する

３．複数ブックでのセル値の一括置換
・Excel起動時にフォーム出力
・フォルダの中にある全てのExcelファイルに同じ処理をするマクロ

４．提出用資料作成
・【エクセルVBA】全シートでA1セルを選択した状態にするマクロ
・Excel：全シートの選択セルをA1にして倍率100%にするVBAマクロ
・シート全体のフォント種別・フォントサイズを変更するExcelマクロ