VBA 0と空白セルのみ斜線を引く

Excel VBA Sample

2025.06.112025.06.12

選択セル範囲5000セル以内で、値が０か空白の場合のみ斜線を引く
エラーセルはスルーする

５０００セル以上になると、フリーズしたようになる可能性があるので、指定している方が安全！

Const MAX_PROCESS As Long = 5000
Sub myDrawBlankDiagonalLine()
    Dim rng As Range, cell As Range
    Dim count As Long
    On Error Resume Next
    Set rng = ActiveWindow.RangeSelection
    If rng Is Nothing Then Exit Sub
    On Error GoTo 0

    If rng.Cells.count > MAX_PROCESS Then
        MsgBox "選択範囲が " & rng.Cells.count & " セルあります。" & vbCrLf & _
               "処理対象は最大 " & MAX_PROCESS & " セルまでです。" & vbCrLf & _
               "セル範囲を分けて選択し直してください。", vbExclamation
        Exit Sub
    End If

    Application.ScreenUpdating = False
    count = 0

    For Each cell In rng.Cells
        If Not IsError(cell.Value) Then
            If Trim(cell.Text) = "" Or cell.Value = 0 Then
                cell.Borders(xlDiagonalUp).LineStyle = xlContinuous
                cell.Borders(xlDiagonalUp).Weight = xlThin
                count = count + 1
            End If
        End If
    Next cell

    Application.ScreenUpdating = True
End Sub
Sub myDelDiagonalLine()
   ActiveWindow.RangeSelection.Borders(xlDiagonalUp).LineStyle = xlNone

End Sub