Sub ClearEmpty()

Application.Calculation = xlCalculationManual   '手動
Dim c As Range
Dim r As Range

'Set r = Range("H2:HF1000")
'Set r = Range("H500:HF1000")
Set r = Selection
Set r = r.SpecialCells(xlCellTypeConstants, xlTextValues)

Debug.Print r.Count

If r.Count > 0 Then
    For Each c In r
        'Debug.Print c.Address
        If Len(c) = 0 Then c.ClearContents
    Next c
    Debug.Print "OK"
End If

Application.Calculation = xlCalculationAutomatic    '自動
End Sub