エラー値チェック(ExcelVBA)

ゆーしゃん
2022.02.12
108 views

概要

アクティブシートに対し、
下記Excel関数のエラー値存在箇所を表示する

#DIV/0!
#N/A
#NAME?
#NULL!
#NUM!
#REF!
#VALUE!

プログラムを作成した理由

「ExcelVBAが多少書けます！」(if、forが分かる程度)と意気揚々と入社して数日後…
とあるCSV変換作業マニュアルを確認していたところ、

「検索と置換」(「Ctrl」+「F」キー)にて「#」を検索し、Excelのエラー値を除外する
※ただし、以下のような「#」はエラー値ではないので、削除しないように注意！

・「C#」はプログラム言語
・「###オススメポイント###」のような装飾

という作業がありました。

毎日毎日、
目視で「この#付き文字は除外…この#付き文字は除外してはいけない…」
と目視判断するのがバカバカしくなったので、

Excel関数のエラー値だけを検出するマクロを作成致しました。

ソースコード

Option Explicit

'概要：エラー値チェックし、該当箇所を表示
'新規作成日：2018/5/10
'最終更新日：2019/12/18
'更新内容：「週#VALUE!日」等文字列で含まれていてもエラーとして表示

Sub エラー検査()
    
    '定数定義
    Const ERR_DIV As String = "#DIV/0!"
    Const ERR_NA As String = "#N/A"
    Const ERR_NAME As String = "#NAME?"
    Const ERR_NULL As String = "#NULL!"
    Const ERR_NUM As String = "#NUM!"
    Const ERR_REF As String = "#REF!"
    Const ERR_VALUE As String = "#VALUE!"
    
    '変数定義
    Dim End_Row As Long
    Dim End_Colomn As Long
    Dim TotalErrName As String
    Dim Result_Row As String
    Dim Cell As Variant
    Dim Err_List As Variant
    Dim ErrMsg_OutPutFlg As Boolean
    
    'ループカウンタ
    Dim Row_Count As Long
    Dim Colomn_Count As Integer
    Dim i As Integer
    
    'エラー値リスト作成
    Err_List = Array(ERR_DIV, ERR_NA, ERR_NAME, ERR_NULL, ERR_NUM, ERR_REF, ERR_VALUE)
    
    '高速化設定
    With Application
    
        .DisplayStatusBar = True             'ステータスバー表示
        .StatusBar = ""                      'ステータスバー文言初期化
        .Calculation = xlCalculationManual   '手動計算に
        .ScreenUpdating = False              '画面描画を停止
    
    End With
    
    '最終行列取得
    With ActiveSheet.UsedRange
        End_Row = .Rows(.Rows.Count).Row
        End_Colomn = .Columns(.Columns.Count).Column
    End With
    
    '全セル取得
    Cell = Range(Cells(1, 1), Cells(End_Row, End_Colomn))
    
    '列ループ
    For Colomn_Count = LBound(Cell, 2) To UBound(Cell, 2)
        
        '初期化
        Result_Row = ""
        
        'ステータスバー更新
        Application.StatusBar = "完了率" & CInt(Colomn_Count / End_Colomn * 100) & "%"
        DoEvents

        '行ループ
        For Row_Count = LBound(Cell, 1) To UBound(Cell, 1)
            
            '初期化
            ErrMsg_OutPutFlg = False
            
            'エラーが発生した場合
            If IsError(Cell(Row_Count, Colomn_Count)) Then
                
                'エラー出力フラグ更新
                ErrMsg_OutPutFlg = True
                
            'エラーが文字列として存在しているかをチェック
            Else
                
                'エラー文言ループ
                For i = LBound(Err_List) To UBound(Err_List)
                    
                    'エラー文言存在チェック
                    If InStr(Cell(Row_Count, Colomn_Count), Err_List(i)) Then
                        
                        'エラー出力フラグ更新
                        ErrMsg_OutPutFlg = True
                        
                        'ループを抜ける
                        Exit For
                        
                    End If
                    
                Next
                
            End If
            
            'エラーが存在した場合、次列へ移行
            If ErrMsg_OutPutFlg Then
                
                Result_Row = Result_Row & Row_Count & ","
            
            End If

        Next
        
        '該当行が存在する場合
        If Result_Row <> "" Then
            
            '末尾「,」除外
            Result_Row = Left(Result_Row, Len(Result_Row) - 1)
            
            TotalErrName = TotalErrName & _
                           GetAlphaName(Colomn_Count) & "列「" & Replace(Cell(1, Colomn_Count), vbLf, "") & "」" & _
                           Result_Row & "行目" & vbLf
        
        End If
                                   
    Next
    
    '高速化設定初期化
    With Application
    
        .StatusBar = ""                          'ステータスバー文言初期化
        .ScreenUpdating = True                   '画面描画を開始
        .Calculation = xlCalculationAutomatic    '自動計算に
    
    End With
    
    '完了メッセージ
    If TotalErrName = "" Then
        
        MsgBox "エラーは存在しませんでした。"
    Else
        MsgBox "下記列にエラーが存在しています。" & vbLf & vbLf & TotalErrName
                    
    End If

End Sub

'列ナンバーをアルファベット列名に変換
Private Function GetAlphaName(ColomnNum As Integer) As String
    
    '変数定義
    Dim ColomnName As String
    
    '列位置→アルファベット列名変換
    ColomnName = Cells(1, ColomnNum).Address(True, False)
    ColomnName = Left(ColomnName, InStr(2, ColomnName, "$") - 1)
    
    '返却値
    GetAlphaName = ColomnName
    
End Function

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

Option Explicit

'概要：エラー値チェックし、該当箇所を表示

'新規作成日：2018/5/10

'最終更新日：2019/12/18

'更新内容：「週#VALUE!日」等文字列で含まれていてもエラーとして表示

Sub エラー検査()

'定数定義

Const ERR_DIV As String = "#DIV/0!"

Const ERR_NA As String = "#N/A"

Const ERR_NAME As String = "#NAME?"

Const ERR_NULL As String = "#NULL!"

Const ERR_NUM As String = "#NUM!"

Const ERR_REF As String = "#REF!"

Const ERR_VALUE As String = "#VALUE!"

'変数定義

Dim End_Row As Long

Dim End_Colomn As Long

Dim TotalErrName As String

Dim Result_Row As String

Dim Cell As Variant

Dim Err_List As Variant

Dim ErrMsg_OutPutFlg As Boolean

'ループカウンタ

Dim Row_Count As Long

Dim Colomn_Count As Integer

Dim i As Integer

'エラー値リスト作成

Err_List = Array(ERR_DIV, ERR_NA, ERR_NAME, ERR_NULL, ERR_NUM, ERR_REF, ERR_VALUE)

'高速化設定

With Application

.DisplayStatusBar = True 'ステータスバー表示

.StatusBar = "" 'ステータスバー文言初期化

.Calculation = xlCalculationManual '手動計算に

.ScreenUpdating = False '画面描画を停止

End With

'最終行列取得

With ActiveSheet.UsedRange

End_Row = .Rows(.Rows.Count).Row

End_Colomn = .Columns(.Columns.Count).Column

End With

'全セル取得

Cell = Range(Cells(1, 1), Cells(End_Row, End_Colomn))

'列ループ

For Colomn_Count = LBound(Cell, 2) To UBound(Cell, 2)

'初期化

Result_Row = ""

'ステータスバー更新

Application.StatusBar = "完了率" & CInt(Colomn_Count / End_Colomn * 100) & "%"

DoEvents

'行ループ

For Row_Count = LBound(Cell, 1) To UBound(Cell, 1)

'初期化

ErrMsg_OutPutFlg = False

'エラーが発生した場合

If IsError(Cell(Row_Count, Colomn_Count)) Then

'エラー出力フラグ更新

ErrMsg_OutPutFlg = True

'エラーが文字列として存在しているかをチェック

Else

'エラー文言ループ

For i = LBound(Err_List) To UBound(Err_List)

'エラー文言存在チェック

If InStr(Cell(Row_Count, Colomn_Count), Err_List(i)) Then

'エラー出力フラグ更新

ErrMsg_OutPutFlg = True

'ループを抜ける

Exit For

End If

'エラーが存在した場合、次列へ移行

If ErrMsg_OutPutFlg Then

Result_Row = Result_Row & Row_Count & ","

End If

'該当行が存在する場合

If Result_Row <> "" Then

'末尾「,」除外

Result_Row = Left(Result_Row, Len(Result_Row) - 1)

TotalErrName = TotalErrName & _

GetAlphaName(Colomn_Count) & "列「" & Replace(Cell(1, Colomn_Count), vbLf, "") & "」" & _

Result_Row & "行目" & vbLf

End If

'高速化設定初期化

With Application

.StatusBar = "" 'ステータスバー文言初期化

.ScreenUpdating = True '画面描画を開始

.Calculation = xlCalculationAutomatic '自動計算に

End With

'完了メッセージ

If TotalErrName = "" Then

MsgBox "エラーは存在しませんでした。"

Else

MsgBox "下記列にエラーが存在しています。" & vbLf & vbLf & TotalErrName

End If

End Sub

'列ナンバーをアルファベット列名に変換

Private Function GetAlphaName(ColomnNum As Integer) As String

'変数定義

Dim ColomnName As String

'列位置→アルファベット列名変換

ColomnName = Cells(1, ColomnNum).Address(True, False)

ColomnName = Left(ColomnName, InStr(2, ColomnName, "$") - 1)

'返却値

GetAlphaName = ColomnName

End Function

感想

毎日毎日、同じ文言を目視判断し続けるって結構辛いと思うのですが…
「目視判断するもの」と認識している現場には「面倒」とすら認識されていないようでした。

DX！RPA！BPR！と取り組む前に、
こうした目の前の
「小石に躓いても怪我はしないけど、地味にイラっとする」

…というような
解決が容易なものを見つけ、効率化していくのが先ではないでしょうか…？？？