【VBAコピペOK】脱初心者！現場で役立つ厳選コード集

基本テンプレート

VBA開発でよく使う書き方をテンプレート化したものです。このコードを基本として、'ここに処理を書く の部分にご自身のVBAコードを記述することで、安定したVBAアプリケーションを開発するとなります。

使い方:

1. このコードをVBAエディターの標準モジュールにコピー＆ペーストします
2. メインの処理をOn Error GoTo Catch:～GoTo Finallyの間に記述します（メインの処理を実行中にエラーが起きなければ、エラー発生時の処理Catch:をスキップして、Finally:に飛びます）
3. エラー発生時の処理はCatch:～Finally:の間に記述します（例として処理中に開いたブックを閉じたり、作成途中のファイルを削除したりなど、切り戻しの処理をここに記述します）
4. 最終的な処理はFinally:～End Subの間に記述します（例として変数の初期化や画面更新の再開などを記述します）

基本テンプレート

Sub Main()

'メインの処理（処理中にエラーが起きたらCatchへ飛ぶ）
On Error GoTo Catch:

    '開始メッセージ（はいが選択されなかった場合エラーを発生させCatchへ飛ぶ）
    If MsgBox("処理を開始しますか？", vbYesNo + vbInformation) <> vbYes Then
        Err.Raise Number:=999, Description:="処理をキャンセルしました"
    End If

    'ここに処理を書く

    '終了メッセージ
    MsgBox "処理が完了しました", vbInformation

    'Finallyへ飛ぶ
    GoTo Finally

'エラーの処理
Catch:

    'ここに処理を書く

    'エラーメッセージ
    MsgBox "エラー番号:" & Err.Number & vbCrLf & _
           "エラー内容:" & Err.Description, vbCritical

'最終的な処理
Finally:

    'ここに処理を書く

End Sub

汎用的なコード、関数

高頻度で使う処理をまとめています。共通部品用のモジュールを作り、そこへまとめてコピペすることをお勧めします。

Excel操作系

開始処理

Sub StartSetting()

    Application.Cursor = xlWait
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    If Application.Calculation = xlCalculationManual Then
        Application.Calculate
    End If

End Sub

終了処理

Sub EndSetting()

    Application.Cursor = xlDefault
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    If Application.Calculation = xlCalculationManual Then
        Application.Calculate
    End If

End Sub

A1に合わせてスクロール

Sub ResetScroll(ByVal targetSheet As Worksheet)

    Application.Goto Reference:=targetSheet.Range("A1"), Scroll:=True

End Sub

クリップボードに文字列をセット

Sub SetClipBoard(ByVal copyText As String)

    With CreateObject("Forms.TextBox.1")
        .MultiLine = True
        .Text = copyText
        .SelStart = 0
        .SelLength = .TextLength
        .Copy
    End With

End Sub

存在チェック系

SharePointやOneDriveなどのHTTPから始まるURL形式のパスでは、FSOは利用できないためご注意ください。

フォルダ存在チェック

Function IsFolderExists(ByVal folderPath As String) As Boolean

  Dim fso As Object

  Set fso = CreateObject("Scripting.FileSystemObject")
  IsFolderExists = fso.FolderExists(folderPath)
  Set fso = Nothing

End Function

ファイル存在チェック

Function IsFileExists(ByVal filePath As String) As Boolean

  Dim fso As Object

  Set fso = CreateObject("Scripting.FileSystemObject")
  IsFileExists = fso.FileExists(filePath)
  Set fso = Nothing

End Function

ブック存在チェック

Function IsBookOpen(ByVal fileName As String) As Boolean

    Dim wb As Workbook

    On Error Resume Next 'エラー無効化（ブックがない場合にエラーになるので）
    Set wb = Workbooks(fileName)
    On Error GoTo 0 'エラー初期化

    IsBookOpen = Not wb Is Nothing

End Function

シート存在チェック

Function IsSheetExists(ByVal targetBook As Workbook, ByVal sheetName As String) As Boolean

    Dim ws As Worksheet

    On Error Resume Next 'エラー無効化（シートがない場合にエラーになるので）
    Set ws = targetBook.Worksheets(sheetName)
    On Error GoTo 0 'エラー初期化

    IsSheetExists = Not ws Is Nothing

End Function

文字列操作系

SharePointやOneDriveなどのHTTPから始まるURL形式のパスでも使えるようにしています。

パスからファイル名取得

Function GetFileName(ByVal filePath As String) As String

    'フォルダパスがURLなら
    If Left(filePath, 4) = "http" Then
        '最後のスラッシュから末尾までを取得
        GetFileName = Mid(filePath, InStrRev(filePath, "/") + 1)
    Else
        '最後のバックスラッシュから末尾までを取得
        GetFileName = Mid(filePath, InStrRev(filePath, "\") + 1)
    End If

End Function

パスからファイル名取得(拡張子無し)

Function GetFileBaseName(ByVal filePath As String) As String

    Dim sFileName As String
    Dim sExtension As String

    'フォルダパスがURLなら
    If Left(filePath, 4) = "http" Then
        '最後のスラッシュから末尾までを取得
        sFileName = Mid(filePath, InStrRev(filePath, "/") + 1)
    Else
        '最後のバックスラッシュから末尾までを取得
        sFileName = Mid(filePath, InStrRev(filePath, "\") + 1)
    End If

    'ファイル名から拡張子を取得
    sExtension = Mid(sFileName, InStrRev(sFileName, "."))

    'ファイル名から拡張子を除去してリターン
    GetFileBaseName = Replace(sFileName, sExtension, "")

End Function

ファイル拡張子取得

Function GetFileExtension(ByVal filePath As String) As String

    GetFileExtension = Mid(filePath, InStrRev(filePath, "."))

End Function

フォルダパスとファイル名を結合

Function JoinPathAndName(ByVal folderPath As String, ByVal fileName As String) As String

    'フォルダパスがURLなら
    If Left(folderPath, 4) = "http" Then
        If Right(folderPath, 1) <> "/" Then
            folderPath = folderPath & "/" '末尾にスラッシュを付ける
        End If
    Else
        If Right(folderPath, 1) <> "\" Then
            folderPath = folderPath & "\" '末尾にバックスラッシュを付ける
        End If
    End If

    JoinPathAndName = folderPath & fileName

End Function

便利関数

大した処理はしていませんが、非常によく使うため関数化したものになります。

セルを検索して取得

Function FindCell(ByVal findRange As Range, ByVal searchText As String) As Range

    Set FindCell = findRange.Find(What:=searchText, lookIn:=xlValues, lookAt:=xlWhole)

End Function

最終行を取得

Function GetLastRow(ByVal targetSheet As Worksheet, ByVal colNum As Long) As Long

    GetLastRow = targetSheet.Cells(targetSheet.Rows.Count, colNum).End(xlUp).row

End Function

最終列を取得

Function GetLastColumn(ByVal targetSheet As Worksheet, ByVal rowNum As Long) As Long

    GetLastColumn = targetSheet.Cells(rowNum, targetSheet.Columns.Count).End(xlToLeft).Column

End Function

このコード集が、あなたのVBA開発の一助となれば幸いです。他にも必要なコードがあれば、ぜひコメントで教えてください！