[[20240316144144]] 『特定のセルが空白ならば斜め斜線を入れる』(Tail Tail) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『特定のセルが空白ならば斜め斜線を入れる』(Tail Tail)

お世話になります。
特定のセル、例えば「G11」に値が無ければ自動で罫線(/)が入る方法を探しています。
良い方法があればご教示ください。

< 使用 Excel:Microsoft365、使用 OS:Windows10 >


vba

if 何処かのシート.Range("G11")=Empty THen 【斜め線ひくのだぁ】という命令^^;
手で引いた方がはやいかもぉ (*^^*)
m(__)m
(隠居Z) 2024/03/16(土) 15:20:51


 ↑ まじめに書いたらこんな感じでせうか。。。(*^^*)
Sub t01()
    With Worksheets("Sheet1")
        With .Range("G11")
            .ClearFormats
            If .Value = Empty Then
                .Borders(5).LineStyle = True
                .Borders(6).LineStyle = True
                Rem xlDiagonalDown 5
                Rem lDiagonalUp 6
            End If
        End With
    End With
End Sub
m(__)m

(隠居Z) 2024/03/16(土) 15:44:55


↑あくまで見本ですので。。。実際は何も確認せず
G11の書式を消したりは致しませんです。はい^^;

m(__)m
(隠居Z) 2024/03/16(土) 15:48:59


  条件付き書式でできれば最上ですが、斜め罫線は非対応のようなので、
 マクロ(ないしは手作業)しか策はないと思われます。
 既に回答いただいているとおりかと思います。

 仮に特定セルがA1:A5範囲とすると、こんな風にするのでしょうか。
 Sub test()
     Dim r As Range
     For Each r In [A1:A5]
         If r.Value = Empty Then
             r.Borders(xlDiagonalUp).LineStyle = True
         Else
             r.Borders(xlDiagonalUp).LineStyle = False
         End If
     Next
 End Sub
(xyz) 2024/03/16(土) 16:25:39

皆様、ありがとうございます。
マクロですと実行しないといけませんよね。希望としてはそのような動き無くして罫線が引けるとうれしいのですが。xyz様のおっしゃる通り、マクロでしか無理でしょうか?
(Tail Tail) 2024/03/16(土) 17:01:49

 >希望としてはそのような動き無くして罫線が引けるとうれしいのですが。
 ということは、頭で考えただけで動いてくれるテレパシーを希望しているということでしょうか。

(xyz) 2024/03/16(土) 17:12:50


ありがとうございました。
(Tail Tail) 2024/03/16(土) 17:16:59

  特定範囲でなくSelection(選択範囲)にするか、
 範囲選択動作を入れるとかするといいのでは?
 クイックツールバーにマクロを登録しておけば起動はワンクリックです。

(xyz) 2024/03/16(土) 18:20:05


 ワークシートのChangeイベントにマクロを設定すればいいのでは。

 Private Sub Worksheet_Change(ByVal Target As Range)
    DiagonalUpBorder Intersect(Range("A1:A5"), Target)
 End Sub

 Sub DiagonalUpBorder(Target As Range)
     Dim r As Range
     For Each r In Target
         If r.Value = Empty Then
             r.Borders(xlDiagonalUp).LineStyle = True
         Else
             r.Borders(xlDiagonalUp).LineStyle = False
         End If
     Next
 End Sub

(hatena) 2024/03/17(日) 00:00:18


 (1)
 |  範囲選択動作を入れるとかするといいのでは?
 これは、次のようなマクロで実現できます。参考まで。

 Sub test()
     Dim myRange As Range
     Dim r       As Range
     Dim prompt  As String

     prompt = "対象セル範囲を選択して,OKボタンをクリックしてください。" _
             & vbLf & "そのなかの空白セルに斜線の罫線を自動で引きます。"
     On Error Resume Next
     Set myRange = Application.InputBox(prompt:=prompt, Type:=8)
     On Error GoTo 0
     If TypeName(myRange) <> "Range" Then Exit Sub

     For Each r In myRange
         If r.Value = Empty Then
             r.Borders(xlDiagonalUp).LineStyle = True
         Else
             r.Borders(xlDiagonalUp).LineStyle = False
         End If
     Next
 End Sub

 マクロを実行すると、範囲指定を促すインプットボックスが表示されます。
 ワークシートのセルを選んでOKボタンをクリックしてください。
 そのなかの空白セルに斜線の罫線を自動で引きます。
 (指定の取り消しはキャンセルボタンをクリックです)
 これをクイックアクセスツールバーに登録しておけば良いかも。

 (2)
 イベントプロシージャは思いもよりませんでした。そうでしたか。

 私は、
  ・入力が終了したあとで、
  ・空白になっているところに一括して斜め斜線を引きたい、
 どうしたら良いか、という質問とばかり思いこんでいましたので
 そういう柔軟な発想は一ミクロンもありませんでした。

 最後まで入力がなかったところに罫線を引くわけですから、
 そこはChangeイベントが発生する対象セルにならないかもしれないです。
 F2を押してからEnterですか?それとも何かをいったん入れてからDeleteですか。

 逆に、何かの入力、その後deleteで、各セルに斜線を引いておいて、
 入力したらそれを消すということでしょうか。
 入力する際に斜線が邪魔になりませんかね。

 質問者さんがマクロを起動する手間がかからないのでよい、
 ということであればそれもよいかもしれませんね。

 なお、
 Private Sub Worksheet_Change(ByVal Target As Range)  の最初に
    If Intersect(Range("A1:A5"), Target) Is Nothing Then Exit Sub
 を一行入れておかないと、Range("A1:A5")以外に入力した時にエラーになっちゃいますね。

 (3)
 | マクロでしか無理でしょうか?
 ということからすると、
 マクロそのものの使用は避けたいのかもしれません。
 それなら、
 ・ひとつのセルに斜線を引いて、それをコピーして、
 ・同様のセル範囲をCtrlキーを押しながらすべて選択して、
 ・貼り付け(Ctrl+V)でしょうか。
 セルの個数によりますが、これが一番手軽かもしれません。
(xyz) 2024/03/17(日) 08:13:29

 質問が、
 > 特定のセル、例えば「G11」に値が無ければ自動で罫線(/)が入る方法

 ということなので、条件は、入力の有無というより、値の有無かなと判断しました。
 思いついたのが条件付き書式ですが、条件付き書式では背景パターンを斜線にするとか、
 セルに画像を配置するとかの代替案は検索すると出てきましたが、斜め罫線は無理っぽいですね。

 ということで、Changeイベントでマクロで引けばいいのではという発想です。

 罫線設定を別プロシージャにしたのは、最初に特定のセル範囲を選択しておいて、
 下記を実行すればいいかなと。
 Call DiagonalUpBorder(Selection)
 これは最初の1回のみでOKですね。
 これで条件付き書式とほぼ同じ動作になります。

 >     If Intersect(Range("A1:A5"), Target) Is Nothing Then Exit Sub
 > を一行入れておかないと、Range("A1:A5")以外に入力した時にエラーになっちゃいますね。

 そうでした。ご指摘ありがとうございます。
 下記に修正したのを置いておきます。

 Private Sub Worksheet_Change(ByVal Target As Range)
    DiagonalUpBorder Intersect(Range("A1:A5"), Target)
 End Sub

 Sub DiagonalUpBorder(Target As Range)
     If Target Is Nothing Then Exit Sub
     Dim r As Range
     For Each r In Target
         If r.Value = Empty Then
             r.Borders(xlDiagonalUp).LineStyle = True
         Else
             r.Borders(xlDiagonalUp).LineStyle = False
         End If
     Next
 End Sub

(hatena) 2024/03/17(日) 09:58:23


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.