エクセルで特定の文字列が入力（プルダウンで選択）されてた時に指定のセルを罫線機能で斜線を表示したい

Question

実現したいこと

エクセルで特定の文字列が入力（プルダウンで選択）されてた時に指定のセルを罫線機能で斜線を表示したい

前提

エクセルには入力と「印刷」と「名前」の付けた２つのシートがあります。
「入力」シートの"H7～H36"に「A」「B」「C」「AB」「BC」と5つの文字列をプルダウンリストで設定してあります。
この"入力!H7"にプルダウンで「AB」もしくは「B」が入力された場合に「印刷」シートの"D5""E5""F5""G5"のセルに斜線が表示れるようにしたいです。
また"入力!H8"に「AB」「B」を入力すると今度は「印刷」シートの"D56""E56""F56""G56"に斜線を表示、"入力!H8"に"D107""E107""F107""G107"に罫線といった処理をしたいです。

発生している問題・エラーメッセージ

現在は名前の定義で「A」「B」「C」「AB」「BC」それぞれの名前を付けたセルに斜線を引いて、INDIRECT関数を使い「印刷」シートに罫線の画像を表示する方法でごまかしているのですが、動作が極端に遅いため、マクロやVBAを使って表示できないかと思い、質問させていただきました。

補足情報（FW/ツールのバージョンなど）

Microsoft　365
Windows 10

Answer 1

下記でどうでしょう。

Public Sub Test()
    Dim i As Long
    For i = 7 To 37
        With Worksheets("印刷").Cells(i * 51 - 352, "D").Resize(, 4).Borders(xlDiagonalDown)
            Select Case Worksheets("入力").Cells(i, "H").Value
            Case "AB", "B"
                .LineStyle = xlContinuous
            Case Else
                .LineStyle = xlNone
            End Select
        End With
    Next
End Sub

入力時にリアルタイムで反応させたい場合のコード

「入力」シートのモジュールに記述

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    Set r = Intersect(Target, Range("H7:H36"))
    If r Is Nothing Then Exit Sub
    Dim c As Range
    For Each c In r
        With Worksheets("印刷").Cells(c.Row * 51 - 352, "D").Resize(, 4).Borders(xlDiagonalUp)
            Select Case c.Value
            Case "AB", "B"
                .LineStyle = xlContinuous
            Case Else
                .LineStyle = xlNone
            End Select
        End With
    Next
End Sub

Comments

[ponigi]

hatena19様

ありがとうございます。
早速テストしてみました。

斜線は右肩上がりが良かったので
.Borders(xlDiagonalDown)を.Borders(xlDiagonalUp)に変更させていただきました。

今回「A」「B」「C」「AB」「BC」入力後このマクロを実行しないと斜線の表示が、更新されないと思うのですが、再実行しなくても自動で実行できるような設定にはできないでしょうか？

それとも、入力するたびに実行されていると処理重たくなってしまうのでしょうか？

[hatena19]

入力時にリアルタイムで反応させたいということですね。
可能です。回答にコードを追記しておきます。

[ponigi]

ありがとうございます。
快適に動いてます。