見出し画像

Excelで小数点を含むセルをチェックするマクロ

Excelで小数点を含む数値が入力されるべきではないブック(シート)があっても、何らかの理由で小数点以下の数値が含まれている場合があります。
原因は、入力者がROUND関数等での端数処理を失念していたり、単にチェック漏れしている等のパターンがあります。

そのExcelブックを管理する側としては、小数点が入力されてしまった以上、対象のセルを特定して、小数点を排除するしかありません。

しかし、具体的にどのセルで小数点が含まれているか探すのは、骨が折れます。

小数点が入力されていることに気づいたきっかけになったセル=小数点を含むセルならよいのですが、SUM関数等の総合計が小数点を含むことに気づいた場合には、具体的な小数点を含むセルが何千個のセルの中から特定しなければならないことがあります。

そういうときには、下記のコードでアクティブシートのセルに、計算式ではなく定数で小数点を含むセル番地をチェックしています。

Sub sb小数点未満を含むセルチェック()
'用途: 小数点未満の端数を含む定数セルがないかチェックし、該当セルを蛍光緑に色付けし表示
'注意: アクティブシートの全セルを対象。セルの値が数式の場合、そのセルはチェック対象外
       
    '------- 変数の宣言 -------
    Dim ws              As Worksheet 'アクティブなワークシートを格納する変数
    Dim rowIdx          As Long      '行番号をループ用に格納する変数
    Dim colIdx          As Long      '列番号をループ用に格納する変数
    Dim cellValue       As Variant   'セルの値を格納する変数
    Dim cellAddress     As String    'セルのアドレスを格納する変数
    Dim fractionalCells As String    '端数があるセルのアドレスを格納する変数
    Dim myMsg As String              'メッセージボックス用変数
    
    '------- 初期設定 -------
    ' アクティブシートを設定
    Set ws = ActiveSheet
 
    ' メッセージボックスおよびイミディエイトウィンドウに表示するセルアドレスを格納する変数
    fractionalCells = "端数があるセル:" & vbCrLf
 
 
    '------- シートの各セルをループしてチェック -------
    For rowIdx = 1 To ws.usedRange.Rows.count
        For colIdx = 1 To ws.usedRange.Columns.count
 
            ' セルが数式を含むか確認し、数式を含む場合はスキップ
            If Not ws.Cells(rowIdx, colIdx).HasFormula Then
                cellValue = ws.Cells(rowIdx, colIdx).Value 'セルの値を取得
 
                ' 数値であり、小数点以下の端数がある場合
                If IsNumeric(cellValue) Then
                    If cellValue <> Int(cellValue) Then
                        cellAddress = ws.Cells(rowIdx, colIdx).Address(False, False)    'アドレスを取得
                        ws.Cells(rowIdx, colIdx).Interior.Color = RGB(102, 255, 51)     '蛍光緑で色付け
                        fractionalCells = fractionalCells & cellAddress & vbCrLf        'アドレスを文字列に追加
                    End If
                End If
                
            End If
 
        Next colIdx
    Next rowIdx

    '------- 結果を表示 -------
    Debug.Print fractionalCells
    ' 最後にまとめてメッセージボックスとイミディエイトウィンドウを表示
    If Len(fractionalCells) > Len("端数があるセル:" & vbCrLf) Then
        myMsg = "端数があるセルをイミディエイトウィンドウへ出力しました。"
        MsgBox myMsg, , "処理結果通知"
        'Exit Sub
    Else
        myMsg = "端数があるセルは見つかりませんでした。"
        MsgBox myMsg, , "処理結果通知"
    End If
End Sub

定数(値)として小数点を含むセルを目立つようにセル色を蛍光緑にするのと、イミディエイトウィンドウに該当のセル番地をDebug.Printする仕組みです。

なお、簡易的なチェックツールなので、「’1.1」(先頭にアポストロフィーをつけている)みたいに文字列として入力されている小数点を含むセルも、抽出対象になります。

もしよろしければサポートをお願いします。今後の執筆のかてにします。