セルを結合しないで、一番上セル右上から一番下セル左下への斜線・・・

質問

エクセルで・・・
　Ａ１からＡ２，Ａ３，Ａ４・・・と下へ見てきて、
　　Ａ３が空白ではなかったら、Ａ１セル右上からＡ２セル左下へ斜線を引く・・・
　　Ａ４が空白ではなかったら、Ａ１セル右上からＡ３セル左下へ斜線を引く・・・
というように設定したいのですが、
このとき、セルを結合したくない場合は、図形を使う以外に方法はありますか？
また、図形を使うとしたら、セルがいくつ空いているかを判定させて、
使う図形を決めておかなくてはならないと思うのですが、
その設定の仕方を教えてください。
できましたら具体的に記述して教えてください。

回答No.1

nishi6 · ベストアンサー

結合しないで線を引く方法は思いつきませんでした。

＞また、図形を使うとしたら、セルがいくつ空いているかを判定させて、
＞使う図形を決めておかなくてはならないと思うのですが、・・・
使う図形を決めておくのも面倒（何個定義すればいい？）なので、自動的に線を引くVBAを書いてみました。線を引きたい列の範囲（連続範囲）を選択して実行します。
質問から、どの列を選択するかは任意ですが、選択列数は１としてあります。

標準モジュールに貼り付けます。
Public Sub myLineAdd()
　　Dim Retu As Integer '線を引く列
　　Dim rg As Range 'セル
　　Dim myLine As Shape '線
　　Dim rgStart, rgEnd As Range '線を引くために基準となる開始セル、終了セル
　　Dim srtX, srtY, endX, endY As Double '線の位置(開始x,y、終了x,y)
　　Dim selStart, selEnd As Long '処理を行う開始行、最終行
　　Dim rw As Long '行カウンタ

　　With Selection
　　　　Retu = Val(.Column) '線を引く列をセットする
　　　　selStart = .Cells(1, 1).Row '対象の最初の行
　　　　selEnd = .Cells(.Rows.Count, 1).Row '対象の最後の行
　　End With

　　For rw = selStart To selEnd
　　　　If Cells(rw, Retu) = "" And rgEnd Is Nothing Then
　　　　　　Set rgEnd = Cells(rw, Retu) '空白セルの最初(線を引く最後)
　　　　End If
　　　　If Cells(rw, Retu) <> "" And Not rgEnd Is Nothing Then
　　　　　　Set rgStart = Cells(rw - 1, Retu) '空白セルの最後(線を引く最初)
　　　　　　'線を引くための座標
　　　　　　srtX = rgStart.Left '開始横座標
　　　　　　srtY = rgStart.Top + rgStart.Height '開始縦座標
　　　　　　endX = rgEnd.Left + rgEnd.Width '最終横座標
　　　　　　endY = rgEnd.Top '最終縦座標
　　　　　　'線を引く
　　　　　　Set myLine = ActiveSheet.Shapes.AddLine(srtX, srtY, endX, endY)
　　　　　　Set rgEnd = Nothing '空白セルの最初を初期化
　　　　End If
　　Next
　　Selection.Cells(1, 1).Select '選択解除
End Sub

お礼

いつもご丁寧なコメントつきのマクロ・・・本当にありがとうございます。
またお世話してください。。。是非ー。。。