【EXCEL】あるセルにAという値が入力されたら既定範囲にマクロを自動実行したい

質問

「あるセルにＡという値が入力されると，既定範囲にマクロを自動実行する」ということはできますか？

たとえばB2に「欠席」という値が入ったらその下のB3～B8までセルを斜線にする.
　　　　C3に「欠席」という値が入ったらその下のC3～C8までセルを斜線にする.

という感じです.マクロサイトもいくつかみたのですが分かりません.お願いします．

回答No.3

zap35 · ベストアンサー

＃０２です。
＞結合して斜線１本にしたかったです
結合するならこんな感じでしょう。ざっとしかテストしてませんが…
ただしB3:B8の複数セルに値が入力されていると、先頭セル以外の値は消えてしまいますがよいですね。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r, trg As Range
　Set trg = Intersect(Target, Range("B2:C2"))
　If Not trg Is Nothing Then
　　For Each r In trg
　　　If r.Value = "欠席" Then
　　　　Application.DisplayAlerts = False
　　　　r.Offset(1, 0).Resize(6, 1).Merge
　　　　Application.DisplayAlerts = True
　　　　r.Offset(1, 0).MergeArea.Borders(xlDiagonalDown) _
　　　　　　　　.LineStyle = xlContinuous
　　　Else
　　　　r.Offset(1, 0).Resize(6, 1).MergeCells = False
　　　　r.Offset(1, 0).Resize(6, 1).Borders(xlDiagonalDown) _
　　　　　　　　.LineStyle = xlNone
　　　End If
　　Next r
　End If
End Sub

お礼

できました！ありがとうございます.vbaってほんと難しいです.できたもののほとんど言語の意味がわからないので少し勉強してみます.

回答No.4

imogasi

VBAが難しいという前に、質問の表現をしっかりしてください。
ーー
欠席という文字入力のセル範囲は制限しないといけないのか。
緩やかで良いのか。
何も書いてない。
＞B2に「欠席」という値が入ったらその下のB3～B8までセルを斜線にする
この場合Ｂ２の下の行から、８行までのように見える。
＞C3に「欠席」という値が入ったらその下のC3～C8までセルを斜線
Ｃ３も含めてしまっている。
＞C3に「欠席」はC２に「欠席」の誤りか。
ーー
そんなことなら簡単になる
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 2 And Target = "欠席" Then '第２列が欠席なら
Range(Target.Offset(1, 0), Cells(8, Target.Column)).Select
Selection.MergeCells = True 'セル結合
With Selection.Borders(xlDiagonalUp) '斜線
.LineStyle = xlContinuous
.Weight = xlThin
End With
End If
End Sub
でどうか。
ただしＣｈａｎｇｅイベントであるが、Ｃａｎｃｅｌなど対応はしてない。

補足

ご回答ありがとうございます．
すいません，C3はC2の間違いです．
文字入力のセル範囲も特定範囲のセルです．

回答No.2

zap35

＞マクロサイトもいくつかみたのですが分かりません
マクロ記録で斜線を引いてみれば、そのマクロは分かりますね。
あとは「値が入力されると」実行されるようにするだけです。いくらでも説明サイトがあると思いますが…

以下のマクロはサンプルです。シー名タブ右クリック→コードの表示で開く画面に貼り付けてください。シートに戻ってB2、C2に「欠席」と入れると斜線が引かれますが、たぶん実際のシートにあわせて修正は必要でしょう。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r, trg As Range
　Set trg = Intersect(Target, Range("B2:C2"))
　If Not trg Is Nothing Then
　　For Each r In trg
　　　If r.Value = "欠席" Then
　　　　r.Offset(1, 0).Resize(6, 1).Borders(xlDiagonalDown) _
　　　　　　　　.LineStyle = xlContinuous
　　　Else
　　　　r.Offset(1, 0).Resize(6, 1).Borders(xlDiagonalDown) _
　　　　　　　　.LineStyle = xlNone
　　　End If
　　Next r
　End If
End Sub

補足

セルの値を変えたらできました！ありがとうございます.
１枠ずつ斜線になったのですが，結合して斜線１本にしたかったです.根本的に勉強不足のようです.ボタンを設置して簡単な背景をマクロで実行くらいしかやったことがありません.

回答No.1

mshr1962

シートの見出しを右クリックして"コードの表示"で表示されるエリアに
下記のマクロを貼り付けてください。
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column > 1 And Target.Row = 2 Then
Target.Offset(1#).Resize(6, 1).Select
Select Case Target.Value
Case "欠席"
With Selection.Borders(xlDiagonalDown)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Case Else
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
End Select
End If
End Sub

お礼

ありがとうございます.コピペだけではできませんでした.
それぞれの言葉の意味すらわかりませんし，勉強不足のようです.言語の１つ１つの基本的なところをおさえるところからのようです.