「特別」なものではありませんが。
例えば
・表の範囲 : A1:E20
・調べる列 : 表の第1列(A列)
・判定方法 : セルの値がエラー値か否か
・斜線の向き: 右上がり
・起動方法 : 手動
の場合。
'---------------↓ ココカラ ↓---------------
Sub Sample()
Dim myRng As Range
Dim myCol As Range
Dim myTmp As Object
Dim myCnt As Integer
'表の範囲を指定
Set myRng = ActiveSheet.Range("A1:E20")
'調べる列を指定
Set myCol = myRng.Columns(1)
'古い斜線を消す
For Each myTmp In ActiveSheet.Shapes
If myTmp.Name = "myLine" Then myTmp.Delete
Next myTmp
'「データが無い行」を数える
For Each myTmp In myCol.Cells
If IsError(myTmp.Value) Then myCnt = myCnt + 1
Next myTmp
'「データが無い行」が無ければ抜ける
If myCnt = 0 Then Exit Sub
'最初の「データが無い行」の位置を調べる
myCnt = myCol.Cells.Count - myCnt + 1
'右上がりの斜線を引く
With ActiveSheet.Shapes.AddLine( _
myRng.Cells(myCnt, myRng.Columns.Count).Offset(0, 1).Left, _
myRng.Cells(myCnt, myRng.Columns.Count).Offset(0, 1).Top, _
myRng.Cells(myRng.Rows.Count, 1).Offset(1, 0).Left, _
myRng.Cells(myRng.Rows.Count, 1).Offset(1, 0).Top)
'(消すときのために)名前をつけておく
.Name = "myLine"
End With
End Sub
'---------------↑ ココマデ ↑---------------
以下のようにしてシートモジュールに記述すれば全自動になります。
(再計算時に描画更新)
※運用方法によっては重くなるかもしれません。
'---------------↓ ココカラ ↓---------------
Private Sub Worksheet_Calculate()
Dim myRng As Range
Dim myCol As Range
Dim myTmp As Object
Dim myCnt As Integer
Set myRng = ActiveSheet.Range("A1:E20")
Set myCol = myRng.Columns(1)
For Each myTmp In ActiveSheet.Shapes
If myTmp.Name = "myLine" Then myTmp.Delete
Next myTmp
For Each myTmp In myCol.Cells
If IsError(myTmp.Value) Then myCnt = myCnt + 1
Next myTmp
If myCnt = 0 Then Exit Sub
myCnt = myCol.Cells.Count - myCnt + 1
With ActiveSheet.Shapes.AddLine( _
myRng.Cells(myCnt, myRng.Columns.Count).Offset(0, 1).Left, _
myRng.Cells(myCnt, myRng.Columns.Count).Offset(0, 1).Top, _
myRng.Cells(myRng.Rows.Count, 1).Offset(1, 0).Left, _
myRng.Cells(myRng.Rows.Count, 1).Offset(1, 0).Top)
.Name = "myLine"
End With
End Sub
'---------------↑ ココマデ ↑---------------
以上ご参考まで。
お礼
ご回答ありがとうございました。 まず手動の方を実行してみたところ バッチリうまくいきました。 その後,自動の方を実行してみて とても感動しました。 まさに思っていた通りのものでした。 本当にありがとうございました。