【VBAコピペOK】現場で役立つ厳選コード集

# 厳選コード集
VBAの標準モジュールへコピペしてお使いください。

```vb:コード
Option Explicit

'--------------------------------------------------------------------------------
' 機　能：メインの処理
' 引　数：なし
' 戻り値：なし
'--------------------------------------------------------------------------------
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:

    'ここに最終的な処理を書く（Objectの初期化など）

End Sub

'--------------------------------------------------------------------------------
' 機　能：処理開始時の設定を行う
' 引　数：なし
' 戻り値：なし
'--------------------------------------------------------------------------------
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

'--------------------------------------------------------------------------------
' 機　能：指定したシートのスクロール位置をリセットする
' 引　数：targetSheet = 対象のシート
' 戻り値：なし
'--------------------------------------------------------------------------------
Sub ResetScroll(ByVal targetSheet As Worksheet)

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

End Sub

'--------------------------------------------------------------------------------
' 機　能：文字列をクリップボードにコピーする
' 引　数：copyText = クリップボードにコピーする文字列
' 戻り値：なし
'--------------------------------------------------------------------------------
Sub SetClipBoard(ByVal copyText As String)

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

End Sub

'--------------------------------------------------------------------------------
' 機　能：フォルダが存在するか判定する関数
' 引　数：folderPath = フォルダのパス（URL形式は非対応）
' 戻り値：True = フォルダ有り、False = フォルダ無し
'--------------------------------------------------------------------------------
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

'--------------------------------------------------------------------------------
' 機　能：ファイルが存在するか判定する関数
' 引　数：filePath = ファイルのパス（URL形式は非対応）
' 戻り値：True = ファイル有り、False = ファイル無し
'--------------------------------------------------------------------------------
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

'--------------------------------------------------------------------------------
' 機　能：ブックを開いているか判定する関数
' 引　数：fileName = ブック名
' 戻り値：True = ブックを開いている、False = ブックを閉じている
'--------------------------------------------------------------------------------
Function IsBookOpen(ByVal fileName As String) As Boolean

    Dim wb As Workbook

    On Error Resume Next 'エラー無効化（ブックがない場合にエラーになるので）
    Set wb = Workbooks(fileName) '指定された名前のブックを取得
    On Error GoTo 0 'エラー初期化

    'wbがNothingならFalse、そうでなければTrueを返す
    If wb Is Nothing Then
        IsBookOpen = False
    Else
        IsBookOpen = True
    End If

End Function

'--------------------------------------------------------------------------------
' 機　能：シートが存在するかどうかを判定する関数
' 引　数：targetBook = 対象のブック、sheetName = シート名
' 戻り値：True = シート有り、False = シート無し
'--------------------------------------------------------------------------------
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 'エラー初期化

    'wsがNothingならFalse、そうでなければTrueを返す
    If ws Is Nothing Then
        IsSheetExists = False
    Else
        IsSheetExists = True
    End If

End Function

'--------------------------------------------------------------------------------
' 機　能：パスを除いたファイル名を取得する関数
' 引　数：filePath = ファイルのパス（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

'--------------------------------------------------------------------------------
' 機　能：拡張子を除いたファイル名を取得する関数
' 引　数：filePath = ファイルのパス（URL形式対応）
' 戻り値：拡張子を除いたファイル名
'--------------------------------------------------------------------------------
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

'--------------------------------------------------------------------------------
' 機　能：ファイルの拡張子を取得する関数
' 引　数：filePath = ファイルのパス（URL形式対応）
' 戻り値：ファイルの拡張子
'--------------------------------------------------------------------------------
Function GetFileExtension(ByVal filePath As String) As String

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

End Function

'--------------------------------------------------------------------------------
' 機　能：フォルダパスとファイル名を結合する関数
' 引　数：folderPath=フォルダのパス, fileName=ファイル名
' 戻り値：結合されたファイルパス
'--------------------------------------------------------------------------------
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

'--------------------------------------------------------------------------------
' 機　能：セルを検索する関数
' 引　数：findRange=検索範囲,searchText=検索文字列
' 戻り値：見つかったセル（見つからなかった場合はNothing）
'--------------------------------------------------------------------------------
Function FindCell(ByVal findRange As Range, ByVal searchText As String) As Range

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

End Function

'--------------------------------------------------------------------------------
' 機　能：最終行番号を取得する関数
' 引　数：targetSheet=対象のシート,colNum=列番号
' 戻り値：最終行番号
'--------------------------------------------------------------------------------
Function GetLastRow(ByVal targetSheet As Worksheet, ByVal colNum As Long) As Long

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

End Function

'--------------------------------------------------------------------------------
' 機　能：最終列番号を取得する関数
' 引　数：targetSheet=対象のシート,rowNum=行番号
' 戻り値：最終列番号
'--------------------------------------------------------------------------------
Function GetLastColumn(ByVal targetSheet As Worksheet, ByVal rowNum As Long) As Long

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

End Function

```