環境依存文字チェック(ExcelVBA)

ゆーしゃん
2022.02.19
13,404 views

概要

Excelのセル上では文字化けしていないが、
ExcelVBAにて文字取得すると「?」に文字化けしてしまう環境依存文字を検出する

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

CSV変換作業マニュアルを確認していたところ
「弊社サイトにアップすると文字化けしてしまう文字を、文字化けしない適当な文字に置き換える」
という作業がありました。

「—」のように一見、分からないものを目視で探す
という事が日常化していた為、

せめて、「ExcelVBA上で文字化けしてしまう文字だけでも検知したい」
と思ったのが理由です。

ソースコード

Option Explicit

Sub 環境依存文字チェック()
    
    '変数定義
    Dim Cell As Variant
    Dim c As Variant
    Dim End_Row As Long
    Dim End_Colomn As Long
    Dim Err_ColomnName As String
    Dim ERR_MSG As String
    Dim Result_Row As String
    Dim temp_Str As String
    
    'ループカウンタ
    Dim Rows_Count As Long
    Dim Colomn_Count As Integer
    Dim i As Integer
    
    Application.Calculation = xlCalculationManual   '手動計算に
    Application.ScreenUpdating = False              '画面描画を停止
    
    '最終行列取得
    With ActiveSheet
        End_Row = .UsedRange.Rows.Count
        End_Colomn = .UsedRange.Columns.Count
    End With
    
    '全セル取得
    Cell = Range(Cells(1, 1), Cells(End_Row, End_Colomn))
    
    '列ループ
    For Colomn_Count = LBound(Cell, 2) To UBound(Cell, 2)
    
        'エラー行空白
        Result_Row = ""
        
        '項目名取得
        Err_ColomnName = GetAlphaName(Colomn_Count) & "列「" & Cell(1, Colomn_Count) & "」"
        
        '行ループ
        For Rows_Count = LBound(Cell, 1) To UBound(Cell, 1)
            
            'セル値格納
            c = Cell(Rows_Count, Colomn_Count)
            
            'エラーではない場合、チェック開始
            If Not IsError(c) Then
                
                '空白ではない場合、チェック開始
                If c <> "" Then
                    
                    'セル内文字数ループ
                    For i = 1 To Len(c)
                        
                        '1文字取得
                        temp_Str = Mid(c, i, 1)
                        
                        '取得値が「?」チェック(文字化け「?」と普通の「?」もどちらも)
                        If Asc(temp_Str) = 63 Then
                            
                            '取得値が「?」であるのに、取得元が「?」ではない
                            If temp_Str <> "?" Then
                                
                                '該当位置格納
                                Result_Row = Result_Row & Rows_Count & "行目:" & i & "文字目" & vbLf
                                
                            End If
                        
                        End If
                    
                    Next
                
                End If
            
            End If
            
        Next
        
        '1列内に環境依存文字が存在する場合
        If Result_Row <> "" Then
        
            'メッセージ格納
            ERR_MSG = ERR_MSG & Err_ColomnName & vbLf & Result_Row & vbLf
        
        End If
        
    Next
    
    Application.ScreenUpdating = True                   '画面描画を開始
    Application.Calculation = xlCalculationAutomatic    '自動計算に
    
        '完了メッセージ
    If ERR_MSG = "" Then
        MsgBox "環境依存文字は存在しませんでした。"
    Else
        MsgBox "下記列に環境依存文字が存在しています。" & vbLf & vbLf & ERR_MSG
    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

Option Explicit

Sub 環境依存文字チェック()

'変数定義

Dim Cell As Variant

Dim c As Variant

Dim End_Row As Long

Dim End_Colomn As Long

Dim Err_ColomnName As String

Dim ERR_MSG As String

Dim Result_Row As String

Dim temp_Str As String

'ループカウンタ

Dim Rows_Count As Long

Dim Colomn_Count As Integer

Dim i As Integer

Application.Calculation = xlCalculationManual '手動計算に

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

'最終行列取得

With ActiveSheet

End_Row = .UsedRange.Rows.Count

End_Colomn = .UsedRange.Columns.Count

End With

'全セル取得

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

'列ループ

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

'エラー行空白

Result_Row = ""

'項目名取得

Err_ColomnName = GetAlphaName(Colomn_Count) & "列「" & Cell(1, Colomn_Count) & "」"

'行ループ

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

'セル値格納

c = Cell(Rows_Count, Colomn_Count)

'エラーではない場合、チェック開始

If Not IsError(c) Then

'空白ではない場合、チェック開始

If c <> "" Then

'セル内文字数ループ

For i = 1 To Len(c)

'1文字取得

temp_Str = Mid(c, i, 1)

'取得値が「?」チェック(文字化け「?」と普通の「?」もどちらも)

If Asc(temp_Str) = 63 Then

'取得値が「?」であるのに、取得元が「?」ではない

If temp_Str <> "?" Then

'該当位置格納

Result_Row = Result_Row & Rows_Count & "行目:" & i & "文字目" & vbLf

End If

'1列内に環境依存文字が存在する場合

If Result_Row <> "" Then

'メッセージ格納

ERR_MSG = ERR_MSG & Err_ColomnName & vbLf & Result_Row & vbLf

End If

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

Application.Calculation = xlCalculationAutomatic '自動計算に

'完了メッセージ

If ERR_MSG = "" Then

MsgBox "環境依存文字は存在しませんでした。"

Else

MsgBox "下記列に環境依存文字が存在しています。" & vbLf & vbLf & ERR_MSG

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

感想

あくまでも、
「ExcelVBA上で文字取得した時に文字化けしたもの」を検知するものなので、

「サイトにアップして文字化けしてしまう文字」を
おまじないのように本マクロを実行すれば見つかる可能性はある…
という程度のものでした。

それでも「週?日のお仕事！」というような
エラー値を含んだデータを載せる可能性が少しでも減らせるならば使う価値はあるかと思います。
~~弊社の社員には理解されず、私しか使ってませんでしたが~~