ray88’s diary

お仕事で困ったとき用の自分用の覚書

ExcelVBA 空欄チェック部品

ExcelVBA 目次 - ray88’s diary
■Function

'-----------------------------------------------------------
' 機能:指定したセルアドレスの空欄がないかチェックする'
' 引数1:チェック対象のセルアドレスを格納した1次元配列
' 引数2:セルのエラーメッセージを格納した1次元配列
'
' 備考:セルアドレスとエラーメッセージは、同じインデックスを持つ
'       要素同士で対応している必要があります。
'       例: CellAddresses(0) = "A1"
'           ErrorMessages(0) = "A1の値を入力してください"
'
' 戻り値:True  - 空欄がない場合
'        False - 空欄がある場合
'-----------------------------------------------------------
Function CheckCells(CellAddresses As Variant, ErrorMessages As Variant) As Boolean
    Dim errMsg As String
    Dim cell As Range
    Dim i As Long
    
    For i = LBound(CellAddresses) To UBound(CellAddresses)
        Set cell = Range(CellAddresses(i))
        If cell.Value = "" Then
            If errMsg <> "" Then
                errMsg = errMsg & vbCrLf
            End If
            errMsg = errMsg & ErrorMessages(i)
        End If
    Next
    
    If errMsg <> "" Then
        MsgBox "以下を入力してから再実行してください:" & vbCrLf & vbCrLf & errMsg, vbExclamation, "Error"
        CheckCells = False
    Else
        CheckCells = True
    End If
End Function

■呼び出し方

Sub TestCheckCells()
    Dim CellAddresses As Variant
    Dim ErrorMessages As Variant
    
    CellAddresses = Array("A1", "B1", "C1")
    ErrorMessages = Array("A1セルが空欄です", _
                           "B1セルが空欄です", _
                           "C1セルが空欄です")
    
    If CheckCells(CellAddresses, ErrorMessages) Then
        MsgBox "All cells have values.", vbInformation, "Success"
    End If
End Sub