Excel データ入力に応じて自動的に斜線を引きたいのですが

質問

ご覧いただきありがとうございます。エクセルで、データが入力されていないときはセルに斜線が引かれていて、データが入力されたら自動的にその斜線が消えるようにできるでしょうか。お分かりになられる方がいらっしゃいましたら、ご教示ください。

　セル範囲はＡ１：Ｃ７で、Ａ１とＢ１には常にデータが入っています。残りのセルに、以下のような感じで斜線を引きたいのです。（黒丸はデータが入っているセルを、白丸は空白セルを表しています）

（最初の状態）
　　Ａ　Ｂ　Ｃ
１　●　●　○　→　Ｃ１セルの左上隅から右下隅にかけて斜線
２　○　○　○　→　Ａ２セルの左上隅からＣ７セルの右下隅にかけて
３　○　○　○　　　１本の斜線
４　○　○　○
５　○　○　○
６　○　○　○
７　○　○　○

（データを追加した状態：ア）
　　Ａ　Ｂ　Ｃ
１　●　●　●　→　Ｃ１セルの斜線は消える
２　●　●　○　→　Ｃ２セルの左上隅から右下隅にかけて斜線
３　○　○　○　→　Ａ３セルの左上隅からＣ７セルの右下隅にかけて
４　○　○　○　　　１本の斜線
５　○　○　○
６　○　○　○
７　○　○　○

（データを追加した状態：イ）
　　Ａ　Ｂ　Ｃ
１　●　●　●　→　Ｃ１セルの斜線は消える
２　●　●　●
３　○　○　○　→　Ａ３セルの左上隅からＣ７セルの右下隅にかけて
４　○　○　○　　　１本の斜線
５　○　○　○
６　○　○　○
７　○　○　○

　以下、データ入力が進むにつれて、斜線が自動的に引き直されてほしいです。また、いったん入力したデータを削除したら、斜線は復活してほしいです。データをとびとびに入力したり削除したりすることはありません。

　わかりにくい説明で恐縮ですが、よろしくお願いいたします。

回答No.6

cafe_au_lait · ベストアンサー

ちょっと変えてみました。もっとすっきり書けると思うのですが・・・。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Integer
Dim n As Integer
Dim TopR As Integer
Dim LeftC As Integer
Dim numR As Integer
Dim numC As Integer

TopR = 3 '先頭の行
LeftC = 3 '先頭の列
numR = 7 '行数
numC = 3 '列数

If Target.Row >= TopR And Target.Column >= LeftC _
And Target.Row <= TopR + numR - 1 And Target.Column <= LeftC + numC - 1 Then
LastRow = Cells(TopR + numR, LeftC).End(xlUp).Row '最終行
n = numC - Application.WorksheetFunction.CountBlank _
(Range(Cells(LastRow, LeftC), Cells(LastRow, LeftC + numC - 1))) '最終行の入力セル数

With ActiveSheet.Shapes("LongLine") '長い斜線の設定
.Left = Cells(TopR, LeftC).Left
.Top = Cells(LastRow + 1, 1).Top
.Height = Cells(TopR + numR, 1).Top - .Top
If LastRow = TopR + numR - 1 Then
.Width = 0
Else
.Width = Cells(1, numC + 1).Left
End If
End With

With ActiveSheet.Shapes("ShortLine") '短い斜線の設定
If n = 3 Then
.Height = 0
Else
.Height = Cells(LastRow, 1).Height
End If
.Top = Cells(LastRow, 1).Top
.Left = Cells(1, LeftC + n).Left
.Width = Cells(1, LeftC + numC).Left - .Left
End With

End If

End Sub

.Top :セルや図形の左上のy座標
.Left :セルや図形の左上のx座標
.Height :セルや図形の高さ
.Width :セルや図形の幅

これらをセル位置に応じて設定しています。
Cells(行番号, 列番号)

以下を適宜変更してください。
TopR = 3 '先頭の行
LeftC = 3 '先頭の列
numR = 7 '行数
numC = 3 '列数

お礼

完璧です！素晴らしいマクロをお教えいただき、本当にありがとうございます！目的のシート作成に当たって、レイアウトの自由度がものすごく上がりました。

私も教えていただくだけでは申し訳ないと思い、昨夜と今日半日、ネットや手元の本を漁ってみましたが、付け焼き刃でどうなるものでもなく、改めて、自在にマクロを組める方は凄いと思いました。

お教えくださったマクロを勉強させていただいて、もっともっと知識を深めたいと思います。この度は本当にありがとうございました。

回答No.5

cafe_au_lait

No.4です。
最後のEnd Subが抜けていました。すみません。

直線に名前は付けましたか？左上の名前ボックスにて変更できます。
Worksheet_Changeは他に重複していませんか？

実行したときはなにかエラーが出ませんでしたか？

補足

動きました！新しいブックにコードを貼り付けて、End Subを付け加えると、期待通りの動作をしてくれました。すばらしいです！ありがとうございます。

…もうひとつだけお教えいただけないでしょうか。

Ａ１：Ｃ７のセル範囲ということでお教えいただいたのですが、これをＢ２：Ｄ８やＤ１４：Ｆ２０というようにセル範囲の開始位置が違う表に適用する場合、コードのどこを変えればよろしいのでしょうか。コード中の数字を色々さわってみたのですが、結局わかりませんでした。なにとぞよろしくお願いいたします。

回答No.4

cafe_au_lait

シートにオートシェイプで右下がりの直線を二本引いて、それぞれShortLine、LongLineと名前を付けておきます（コード内の表記と一致していればなんでもいいです）。
その後、以下のコードをシートモジュールに貼り付けてください。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Integer
Dim n As Integer
Dim numR As Integer
Dim numC As Integer

numR = 7 '行数
numC = 3 '行数

If Target.Row <= numR And Target.Column <= numC Then
LastRow = Cells(numR + 1, 1).End(xlUp).Row '最終行
n = numC - Application.WorksheetFunction.CountBlank _
(Range(Cells(LastRow, 1), Cells(LastRow, numC))) '最終行の入力セル数

With ActiveSheet.Shapes("LongLine") '長い斜線の設定
.Left = 0
.Top = Cells(LastRow + 1, 1).Top
.Height = Cells(numR + 1, 1).Top - .Top
If LastRow = numR Then
.Width = 0
Else
.Width = Cells(1, numC + 1).Left
End If
End With

With ActiveSheet.Shapes("ShortLine") '短い斜線の設定
If n = 3 Then
.Height = 0
Else
.Height = Cells(LastRow, 1).Height
End If
.Top = Cells(LastRow, 1).Top
.Left = Cells(1, n + 1).Left
.Width = Cells(1, numC + 1).Left - .Left
End With

End If

補足

丁寧なご指導ありがとうございます。オートシェイプで線を描いてから、上のコードをSheet1(Sheet1)に貼り付けて試してみたのですが、データを入力しても変化がありません。どのようにすればよろしいでしょうか。何度も恐縮ですが、ご指導よろしくお願いいたします。

回答No.3

cafe_au_lait

まとめて1本の斜線にこだわるとしたら、直線を描いてサイズを随時変更していくことになると思います。やはりVBAになります。

補足

ご回答ありがとうございます。

＞まとめて1本の斜線にこだわるとしたら

　そうなんです。Ａ２：Ｃ７など、矩形になるところは１本の線で引くように指定されているんです。

回答No.2

imogasi

VBAのイベントプロを使わざるを得ないでしょう。
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = "" Then
Target.Borders(xlDiagonalUp).LineStyle = xlContinuous
Target.Borders(xlDiagonalUp).LineStyle = xlThick
Else
Target.Borders(xlDiagonalUp).LineStyle = xlLineStyleNone
End If
End Sub
入力される可能性のあるセルに、斜線をセル（範囲）に引いておく。
を例えばSheet1のシートモジュールのChangeイベントに貼り付ける。
データを入れると斜線が消えデータが入る。
DELキーでデータ値を消すと斜線がでる。
ほかに上記効果を効かす範囲限定をVBAに組み込む必要があるかも。
ーー
条件付書式は、罫線を左右するは、カバーしていない。
まして関数は無力、値のみ左右させられる。

補足

ご回答ありがとうございます。お教えいただいたコードを試してみました。xlDiagonalUpは右下がりの斜線を引く命令だと思いますが、実行してみると右上がりの斜線が引かれました。原因がお分かりになられましたらお教えいただけますでしょうか。

＞ほかに上記効果を効かす範囲限定をVBAに組み込む必要があるかも。

　Ａ１：Ｃ７以外のセルも別の入力に使いますので、この方法もぜひお教えください。

　あと、もうひとつわがままなお願いをさせていただいてよろしいでしょうか。お示しいただいたコードですと各セルごとに斜線が引かれますが、Ａ２：Ｃ７やＡ３：Ｃ７のように矩形になった部分には一気に１本の右下がりの線が入ってほしいのです。そのようなコードをお教えいただければ大変有り難く存じます。

　あつかましいお願いで申し訳ありませんが、よろしくお願いいたします。

回答No.1

Kazamin

当方、Excel2002を使用しています。
ご質問の内容から判断すると、条件付き書式機能を使うのが
一番てっとり早いと考えたのですが、条件付き書式では斜め罫線を
引く機能はありませんでした。
上位バージョンではサポートされているかもしれません。

それ以外では、マクロを書けば実現できます。
具体的な記述はひとまず避けますが、指針としては、該当ワークシートの
Worksheet_Changeイベントにご質問の仕様を記述すればいいのかと。
もしサンプルコードが必要であれば、追記いたします。

補足

早速のご回答ありがとうございます。マクロの記述に挑戦しようとしたのですが、私、記録マクロ程度しかわからないことに気付きました(^^;　かなり無謀なことを望んでいるようですね。

　お手間をおかけいたしますが、サンプルコードをお教えいただけますでしょうか。よろしくお願いいたします。

　ちなみに、私が使っているExcelも2002でした。