Excel VBA 質問スレッド №1517 (解決済)
Changeイベントでうまく行かず困っております
投稿者 : たけ 投稿日時 : 2023/07/30(Sun) 07:40:18 OS : Windows 10 EXCEL : Office 365
VBA初心者です。
セルに入力規則（入庫.出庫.発注.棚卸.取り消し）を持たせた状態で、
セルの値に応じて背景色を変えたり消したりするコードを作りたいのですが、
以下の〇印から下のコードが動かず困っております。
条件が2つ揃う場合、別シートのセルの値(i)を参照して処理を行いたいです。
また(i)は列によって変化するようにもしたいです。
でも、(i)あたりの書き方が間違っているように思いますが、
iの値を整数に変えても動きませんでした。
何が悪いのかお教えいただけないでしょうか。
よろしくお願いします。
VBA初心者です。
セルに入力規則（入庫.出庫.発注.棚卸.取り消し）を持たせた状態で、
セルの値に応じて背景色を変えたり消したりするコードを作りたいのですが、
以下の〇印から下のコードが動かず困っております。
条件が2つ揃う場合、別シートのセルの値(i)を参照して処理を行いたいです。
また(i)は列によって変化するようにもしたいです。
でも、(i)あたりの書き方が間違っているように思いますが、
iの値を整数に変えても動きませんでした。
何が悪いのかお教えいただけないでしょうか。
よろしくお願いします。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow As Long
lRow = Cells(Rows.Count, "J").End(xlUp).Row
Dim j
Dim k
k = 12
For j = 32 To 179 Step 3
Set Rng1 = Range(Cells(45, j), Cells(lRow, j))
Next
Set Target = Rng1
Set i = Sheets("型式.部品情報設定").Cells(k, 30)
If Intersect(Target, Rng1) Is Nothing Then
Exit Sub
ElseIf ActiveCell.Value = "入庫" Then
ActiveCell.Resize(1, 3).Interior.Color = RGB(152, 251, 152)
ActiveCell.Font.Color = RGB(0, 0, 0)
ElseIf ActiveCell.Value = "発注" Then
ActiveCell.Resize(1, 3).Interior.ColorIndex = 0
ActiveCell.Font.Color = RGB(255, 0, 0)
ActiveCell.Font.Bold = True
ElseIf ActiveCell.Value = "棚卸" Then
ActiveCell.Resize(1, 3).Interior.Color = RGB(250, 215, 250)
ActiveCell.Font.Color = RGB(0, 0, 0)
ElseIf ActiveCell.Value = "取消" Then
ActiveCell.Resize(1, 2).ClearContents
ActiveCell.Resize(1, 3).Interior.ColorIndex = 0
〇 ElseIf ActiveCell.Value = "入庫" And ActiveCell.Offset(-i, 0).Value = "" Then 'アクティブセルの値が"入庫"でアクティブセル～上に(i)個目のセルに値が無い場合
ActiveCell.Offset(-i, 0).Interior.Color = RGB(255, 230, 230) 'アクティブセル～上に(i)個目のセルの背景色を薄い赤色に変更
ElseIf ActiveCell.Value = "取消" And ActiveCell.Offset(-i, 0).Interior.ColorIndex = xlNone Then 'アクティブセルの値が"入庫"でアクティブセル～上に(i)個目の
セルが塗りつぶされて無い場合
Else ' 塗りつぶしありの場合の処理
ActiveCell.Offset(-i, 0).Interior.ColorIndex = 0 'アクティブセル～上に(i)個目のセルの背景色をクリア ※背景色指定RGB(255, 230, 230)して処理しようとしたが出
来なかったので背景色ありはすべてInterior.ColorIndex = 0とする
End If
k = k + 1
End Sub
スポンサーリンク
[返信 1] Re : Changeイベントでうまく行かず困っております
投稿者 : さんこう 投稿日時 : 2023/07/30(Sun) 08:07:18
全体的に謎なコードですが、
「以下の〇印から下のコードが動かず」についてだけ。
「ActiveCell.Value」が 「入庫」のときは、
「ElseIf ActiveCell.Value = "入庫" Then」の
処理がなされるので、ここ↓にはたどり着きません。
「ElseIf ActiveCell.Value = "入庫" And ActiveCell.Offset(-i, 0).Value = "" Then 'アクティブセルの値が"入庫"でアクティブセル～上に(i)個目のセルに値が無い場合」
全体的に謎なコードですが、
「以下の〇印から下のコードが動かず」についてだけ。
「ActiveCell.Value」が 「入庫」のときは、
「ElseIf ActiveCell.Value = "入庫" Then」の
処理がなされるので、ここ↓にはたどり着きません。
「ElseIf ActiveCell.Value = "入庫" And ActiveCell.Offset(-i, 0).Value = "" Then 'アクティブセルの値が"入庫"でアクティブセル～上に(i)個目のセルに値が無い場合」
[返信 2] Re : Changeイベントでうまく行かず困っております
投稿者 : てらてら 投稿日時 : 2023/07/30(Sun) 08:21:57
こんにちは。
別件ですが、
最後に k をインクリメントしていますが、k に対するFor文がありません。
こんにちは。
別件ですが、
最後に k をインクリメントしていますが、k に対するFor文がありません。
[返信 3] Re : Changeイベントでうまく行かず困っております
投稿者 : さんこう 投稿日時 : 2023/07/30(Sun) 18:52:53
何をしようとしているのかはっきりしないので、間違っているかもしれませんが
全体の構成としてはこんな感じになるのではないでしょうか。
参考になれば。
何をしようとしているのかはっきりしないので、間違っているかもしれませんが
全体の構成としてはこんな感じになるのではないでしょうか。
参考になれば。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow As Long
lRow = Cells(Rows.Count, "J").End(xlUp).Row
Dim i As Long, j As Long, k As Long
Dim Rng1 As Range
k = 12
For j = 32 To 179 Step 3
Set Rng1 = Range(Cells(45, j), Cells(lRow, j))
i = Sheets("型式.部品情報設定").Cells(k, 30)
If Not Intersect(Target, Rng1) Is Nothing Then
If Target.Value = "入庫" Then
'記載省略
End If
End If
k = k + 1
Next j
End Sub
[返信 4] Re : Changeイベントでうまく行かず困っております
投稿者 : たけのこ 投稿日時 : 2023/07/30(Sun) 19:30:08
https://www.excel.studio-kazu.jp/kw/20230730160849.html?t=191902
https://www.excel.studio-kazu.jp/kw/20230730160849.html?t=191902
[返信 5] Re : Changeイベントでうまく行かず困っております
投稿者 : たけ 投稿日時 : 2023/07/30(Sun) 21:11:16
■[返信 3] さんこうさん（2023-07-30 18:52:53）の記事
＞ 何をしようとしているのかはっきりしないので、間違っているかもしれませんが
＞
＞ 全体の構成としてはこんな感じになるのではないでしょうか。
＞
＞ 参考になれば。
＞
＞
＞ Private Sub Worksheet_Change(ByVal Target As Range)
＞ Dim lRow As Long
＞ lRow = Cells(Rows.Count, "J").End(xlUp).Row
＞
＞ Dim i As Long, j As Long, k As Long
＞ Dim Rng1 As Range
＞
＞ k = 12
＞ For j = 32 To 179 Step 3
＞
＞ Set Rng1 = Range(Cells(45, j), Cells(lRow, j))
＞
＞ i = Sheets("型式.部品情報設定").Cells(k, 30)
＞
＞ If Not Intersect(Target, Rng1) Is Nothing Then
＞
＞ If Target.Value = "入庫" Then
＞
＞ '記載省略
＞
＞ End If
＞
＞ End If
＞ k = k + 1
＞ Next j
＞
＞ End Sub
＞
＞
てらてら様
さんこうさん様
たけのこ様
返信できず申し訳ありませんでした。
午後から何度も更新しようとしましたが全くできずスレッドが撥ねられてしまうので
仕方なく他で質問しています。
さんこう先生の回答が参考になり少し進めたので早速御礼と質問を送ろうとしたのですが・・
大変失礼しました。
まずはこのコードを見てみます！いつもありがとうございます！
■[返信 3] さんこうさん（2023-07-30 18:52:53）の記事
＞ 何をしようとしているのかはっきりしないので、間違っているかもしれませんが
＞
＞ 全体の構成としてはこんな感じになるのではないでしょうか。
＞
＞ 参考になれば。
＞
＞
＞ Private Sub Worksheet_Change(ByVal Target As Range)
＞ Dim lRow As Long
＞ lRow = Cells(Rows.Count, "J").End(xlUp).Row
＞
＞ Dim i As Long, j As Long, k As Long
＞ Dim Rng1 As Range
＞
＞ k = 12
＞ For j = 32 To 179 Step 3
＞
＞ Set Rng1 = Range(Cells(45, j), Cells(lRow, j))
＞
＞ i = Sheets("型式.部品情報設定").Cells(k, 30)
＞
＞ If Not Intersect(Target, Rng1) Is Nothing Then
＞
＞ If Target.Value = "入庫" Then
＞
＞ '記載省略
＞
＞ End If
＞
＞ End If
＞ k = k + 1
＞ Next j
＞
＞ End Sub
＞
＞
てらてら様
さんこうさん様
たけのこ様
返信できず申し訳ありませんでした。
午後から何度も更新しようとしましたが全くできずスレッドが撥ねられてしまうので
仕方なく他で質問しています。
さんこう先生の回答が参考になり少し進めたので早速御礼と質問を送ろうとしたのですが・・
大変失礼しました。
まずはこのコードを見てみます！いつもありがとうございます！
[返信 6] Re : Changeイベントでうまく行かず困っております
投稿者 : さんこう 投稿日時 : 2023/07/31(Mon) 08:31:45
「他で質問」のほうでの説明を拝見しまして、少しは見えてきた気がします。
2023/07/30(Sun) 18:52:53に参考として提示したコードは、
Changeイベントの使い方としては少しおかしい気がしますが、とりあえず動くかと思います。
（説明を読み違えてなければ。）
こちら↓は、自分が書くならこうなるかなというものです。
ややこしい書き方をしているので参考にならないかもしれませんが載せておきます。
「他で質問」のほうでの説明を拝見しまして、少しは見えてきた気がします。
2023/07/30(Sun) 18:52:53に参考として提示したコードは、
Changeイベントの使い方としては少しおかしい気がしますが、とりあえず動くかと思います。
（説明を読み違えてなければ。）
こちら↓は、自分が書くならこうなるかなというものです。
ややこしい書き方をしているので参考にならないかもしれませんが載せておきます。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow As Long
lRow = Cells(Rows.Count, "J").End(xlUp).Row
Dim i As Long, k As Long
Dim Tgt1 As Range
Set Tgt1 = Target(1) '複数セルが更新されたときは、先頭の1セルのみとする
If (Tgt1.Column - 32) Mod 3 = 0 And Tgt1.Row >= 45 And Tgt1.Row <= lRow Then '処理対象範囲
k = (Tgt1.Column - 32) / 3 + 12
i = Sheets("型式.部品情報設定").Cells(k, "AD")
Select Case Tgt1.Value
Case "入庫"
Tgt1.Resize(1, 3).Interior.Color = RGB(152, 251, 152)
Tgt1.Font.Color = RGB(0, 0, 0)
If Tgt1.Offset(-i, 0).Value = "" Then
Tgt1.Offset(-i, 0).Interior.Color = RGB(255, 230, 230)
End If
Case "発注"
Tgt1.Resize(1, 3).Interior.ColorIndex = 0
Tgt1.Font.Color = RGB(255, 0, 0)
Tgt1.Font.Bold = True
Case "棚卸"
'記載省略
Case "取消"
'記載省略
Case Else
'記載省略
End Select
End If
End Sub
[返信 7] Re : Changeイベントでうまく行かず困っております
投稿者 : たけ 投稿日時 : 2023/07/31(Mon) 22:18:51
■[返信 3] さんこうさん（2023-07-30 18:52:53）の記事
＞ 何をしようとしているのかはっきりしないので、間違っているかもしれませんが
＞
＞ 全体の構成としてはこんな感じになるのではないでしょうか。
＞
＞ 参考になれば。
＞
＞
＞ Private Sub Worksheet_Change(ByVal Target As Range)
＞ Dim lRow As Long
＞ lRow = Cells(Rows.Count, "J").End(xlUp).Row
＞
＞ Dim i As Long, j As Long, k As Long
＞ Dim Rng1 As Range
＞
＞ k = 12
＞ For j = 32 To 179 Step 3
＞
＞ Set Rng1 = Range(Cells(45, j), Cells(lRow, j))
＞
＞ i = Sheets("型式.部品情報設定").Cells(k, 30)
＞
＞ If Not Intersect(Target, Rng1) Is Nothing Then
＞
＞ If Target.Value = "入庫" Then
＞
＞ '記載省略
＞
＞ End If
＞
＞ End If
＞ k = k + 1
＞ Next j
＞
＞ End Sub
＞
＞
さんこうさん様
しばらく時間がたってしまい申し訳ありません。
さんこうさんにお教えいただいた上のコードで
入庫だけ作ってみたのですが、いろいろ試してもi値が反映されません。
おかしい部分がありますでしょうか。
■[返信 3] さんこうさん（2023-07-30 18:52:53）の記事
＞ 何をしようとしているのかはっきりしないので、間違っているかもしれませんが
＞
＞ 全体の構成としてはこんな感じになるのではないでしょうか。
＞
＞ 参考になれば。
＞
＞
＞ Private Sub Worksheet_Change(ByVal Target As Range)
＞ Dim lRow As Long
＞ lRow = Cells(Rows.Count, "J").End(xlUp).Row
＞
＞ Dim i As Long, j As Long, k As Long
＞ Dim Rng1 As Range
＞
＞ k = 12
＞ For j = 32 To 179 Step 3
＞
＞ Set Rng1 = Range(Cells(45, j), Cells(lRow, j))
＞
＞ i = Sheets("型式.部品情報設定").Cells(k, 30)
＞
＞ If Not Intersect(Target, Rng1) Is Nothing Then
＞
＞ If Target.Value = "入庫" Then
＞
＞ '記載省略
＞
＞ End If
＞
＞ End If
＞ k = k + 1
＞ Next j
＞
＞ End Sub
＞
＞
さんこうさん様
しばらく時間がたってしまい申し訳ありません。
さんこうさんにお教えいただいた上のコードで
入庫だけ作ってみたのですが、いろいろ試してもi値が反映されません。
おかしい部分がありますでしょうか。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow As Long
lRow = Cells(Rows.Count, "J").End(xlUp).Row
Dim i As Long, j As Long, k As Long
Dim Rng1 As Range
k = 12
For j = 32 To 179 Step 3
Set Rng1 = Range(Cells(45, j), Cells(lRow, j))
i = Sheets("型式.部品情報設定").Cells(k, 30)
If Not Intersect(Target, Rng1) Is Nothing Then
If Target.Value = "入庫" Then
If ActiveCell.Value = "入庫" Then
ActiveCell.Offset(-i, 0).Interior.Color = RGB(255, 230, 230)
ActiveCell.Resize(1, 3).Interior.Color = RGB(152, 251, 152)
ActiveCell.Font.Color = RGB(0, 0, 0)
End If
End If
k = k + 1
Next j
End Sub
[返信 8] Re : Changeイベントでうまく行かず困っております
投稿者 : さんこう 投稿日時 : 2023/07/31(Mon) 22:47:26
＞i値が反映されません
「i値が反映」の意味がわかりませんが、
「Target」と「ActiveCell」が異なっているからではないかと思います。
変更されたセルが「Target」ですが、入力後にセルが移動した先（一般には一つ下）が「ActiveCell」になります。
「ActiveCell」には「入庫」と書かれていないので、
これ↓の条件にあわず、何も起きないのではないでしょうか。
If ActiveCell.Value = "入庫" Then
＞i値が反映されません
「i値が反映」の意味がわかりませんが、
「Target」と「ActiveCell」が異なっているからではないかと思います。
変更されたセルが「Target」ですが、入力後にセルが移動した先（一般には一つ下）が「ActiveCell」になります。
「ActiveCell」には「入庫」と書かれていないので、
これ↓の条件にあわず、何も起きないのではないでしょうか。
If ActiveCell.Value = "入庫" Then
[返信 9] Re : Changeイベントでうまく行かず困っております
投稿者 : たけ 投稿日時 : 2023/08/01(Tue) 06:45:26
■[返信 8] さんこうさん（2023-07-31 22:47:26）の記事
＞ ＞i値が反映されません
＞
＞ 「i値が反映」の意味がわかりませんが、
＞
＞ 「Target」と「ActiveCell」が異なっているからではないかと思います。
＞
＞ 変更されたセルが「Target」ですが、入力後にセルが移動した先（一般には一つ下）が「ActiveCell」になります。
＞
＞ 「ActiveCell」には「入庫」と書かれていないので、
＞
＞ これ↓の条件にあわず、何も起きないのではないでしょうか。
＞
＞ If ActiveCell.Value = "入庫" Then
＞
ありがとうございます。
しかし、入力規則から選んでいるので、セル移動しておらず、きちんと
ActiveCell.Resize(1, 3).Interior.Color = RGB(152, 251, 152)
ActiveCell.Font.Color = RGB(0, 0, 0)
にはなってくれるのですが
ActiveCell.Offset(-i, 0).Interior.Color = RGB(255, 230, 230)
がうまく行かないのです。
■[返信 8] さんこうさん（2023-07-31 22:47:26）の記事
＞ ＞i値が反映されません
＞
＞ 「i値が反映」の意味がわかりませんが、
＞
＞ 「Target」と「ActiveCell」が異なっているからではないかと思います。
＞
＞ 変更されたセルが「Target」ですが、入力後にセルが移動した先（一般には一つ下）が「ActiveCell」になります。
＞
＞ 「ActiveCell」には「入庫」と書かれていないので、
＞
＞ これ↓の条件にあわず、何も起きないのではないでしょうか。
＞
＞ If ActiveCell.Value = "入庫" Then
＞
ありがとうございます。
しかし、入力規則から選んでいるので、セル移動しておらず、きちんと
ActiveCell.Resize(1, 3).Interior.Color = RGB(152, 251, 152)
ActiveCell.Font.Color = RGB(0, 0, 0)
にはなってくれるのですが
ActiveCell.Offset(-i, 0).Interior.Color = RGB(255, 230, 230)
がうまく行かないのです。
[返信 10] Re : Changeイベントでうまく行かず困っております
投稿者 : さんこう 投稿日時 : 2023/08/01(Tue) 08:01:22
＞入力規則から選んでいるので、セル移動しておらず
なるほど。とはいえ、ActiveCellだと違和感があるので、Targetに変えておいたほうがいいでしょう。
（好みもあるので、ムリにとはいいませんが）
＞ActiveCell.Offset(-i, 0).Interior.Color = RGB(255, 230, 230)
＞がうまく行かないのです。
「うまく行かない」といった漠然としたとらえ方をしていると解決できません。
そのときの「i」の値がいくつになっているか確認してみてはいかがでしょうか。
想定と違っているなら、「i = Sheets("型式.部品情報設定").Cells(k, 30)」に問題があるので、
そちらの詳細（「k」の値とか、「型式.部品情報設定」シートの「Cells(k, 30)」の値）を確認していきます。
変数などの値の確認方法は、こちら↓を参考にしてください。
＜vba デバッグ 変数の中身＞
https://www.google.com/search?q=vba+%E3%83%87%E3%83%90%E3%83%83%E3%82%B0+%E5%A4%89%E6%95%B0%E3%81%AE%E4%B8%AD%E8%BA%AB
＞入力規則から選んでいるので、セル移動しておらず
なるほど。とはいえ、ActiveCellだと違和感があるので、Targetに変えておいたほうがいいでしょう。
（好みもあるので、ムリにとはいいませんが）
＞ActiveCell.Offset(-i, 0).Interior.Color = RGB(255, 230, 230)
＞がうまく行かないのです。
「うまく行かない」といった漠然としたとらえ方をしていると解決できません。
そのときの「i」の値がいくつになっているか確認してみてはいかがでしょうか。
想定と違っているなら、「i = Sheets("型式.部品情報設定").Cells(k, 30)」に問題があるので、
そちらの詳細（「k」の値とか、「型式.部品情報設定」シートの「Cells(k, 30)」の値）を確認していきます。
変数などの値の確認方法は、こちら↓を参考にしてください。
＜vba デバッグ 変数の中身＞
https://www.google.com/search?q=vba+%E3%83%87%E3%83%90%E3%83%83%E3%82%B0+%E5%A4%89%E6%95%B0%E3%81%AE%E4%B8%AD%E8%BA%AB
[返信 11] Re : Changeイベントでうまく行かず困っております
投稿者 : さんこう 投稿日時 : 2023/08/01(Tue) 08:08:44
追加で。
「Cells(k, 30)」ですが、Cellsプロパティの列の指定には、アルファベット表記の列番号が使えます。
「Cells(k, 30)」の場合は、「「Cells(k, "AD")」」と書くことができます。
（R1C1形式で表示しているのであれば、無視していいです）
追加で。
「Cells(k, 30)」ですが、Cellsプロパティの列の指定には、アルファベット表記の列番号が使えます。
「Cells(k, 30)」の場合は、「「Cells(k, "AD")」」と書くことができます。
（R1C1形式で表示しているのであれば、無視していいです）
[返信 12] Re : Changeイベントでうまく行かず困っております
投稿者 : さんこう 投稿日時 : 2023/08/01(Tue) 10:11:29
もう一点。
「End If」がひとつ足りないです。
「インデント」を正しくつけておかないと、こういった誤りを見逃してしまいます。
（今回のケースでは、エラーになるので気づくでしょうけど）
参考になれば。
＜VBA インデント＞
https://www.google.com/search?q=VBA+%E3%82%A4%E3%83%B3%E3%83%87%E3%83%B3%E3%83%88
もう一点。
「End If」がひとつ足りないです。
「インデント」を正しくつけておかないと、こういった誤りを見逃してしまいます。
（今回のケースでは、エラーになるので気づくでしょうけど）
参考になれば。
＜VBA インデント＞
https://www.google.com/search?q=VBA+%E3%82%A4%E3%83%B3%E3%83%87%E3%83%B3%E3%83%88
[返信 13] Re : Changeイベントでうまく行かず困っております
投稿者 : たけ 投稿日時 : 2023/08/11(Fri) 09:10:02
さんこう先生 こんにちは
先生に教えていただいたサンプルをもとにして
自分でわかる範囲で以下のコードを作ってみました
「処理対象範囲」の部分は自分には理解ができなかったのですが
ローカルウィンドウで変数の値を確認して問題ないと思いました。
しかし、実行してみると
Case "入庫" の部分で
「実行時エラー13 型が一致しません」とエラーになります。
型が一致しませんとはどういうことなのかわかりません。
色々試しましたが、変数の値は正しいのに何でだろうと悩んでいます。
ご教授をお願いいたします。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow As Long
lRow = Cells(Rows.Count, "J").End(xlUp).Row
Dim i As Long, j As Long, k As Long
Dim Tgt1 As Range
Set Tgt1 = Target(1)
k = 12
For j = 32 To 179 Step 3
Set Tgt1 = Range(Cells(45, j), Cells(lRow, j))
i = Sheets("型式.部品情報設定").Cells(k, 30)
If Not Intersect(Target, Tgt1) Is Nothing Then
Select Case Tgt1.Value
Case "入庫"
Tgt1.Resize(1, 3).Interior.Color = RGB(152, 251, 152)
Tgt1.Font.Color = RGB(0, 0, 0)
If Tgt1.Offset(-i, 0).Value = "" Then
Tgt1.Offset(-i, 0).Interior.Color = RGB(255, 230, 230)
End If
Case "発注"
Tgt1.Resize(1, 3).Interior.ColorIndex = 0
Tgt1.Font.Color = RGB(255, 0, 0)
Tgt1.Font.Bold = True
Case "棚卸"
Tgt1.Resize(1, 3).Interior.Color = RGB(250, 215, 250)
Tgt1.Font.Color = RGB(0, 0, 0)
Case "取消"
Tgt1.Resize(1, 2).ClearContents
Tgt1.Resize(1, 3).Interior.ColorIndex = 0
If Tgt1.Offset(-i, 0).Interior.ColorIndex = xlNone Then
Else
Tgt1.Offset(-i, 0).Interior.ColorIndex = 0
Tgt1.Resize(1, 2).ClearContents
Tgt1.Resize(1, 3).Interior.ColorIndex = 0
End If
End Select
End If
k = k + 1
Next j
さんこう先生 こんにちは
先生に教えていただいたサンプルをもとにして
自分でわかる範囲で以下のコードを作ってみました
「処理対象範囲」の部分は自分には理解ができなかったのですが
ローカルウィンドウで変数の値を確認して問題ないと思いました。
しかし、実行してみると
Case "入庫" の部分で
「実行時エラー13 型が一致しません」とエラーになります。
型が一致しませんとはどういうことなのかわかりません。
色々試しましたが、変数の値は正しいのに何でだろうと悩んでいます。
ご教授をお願いいたします。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow As Long
lRow = Cells(Rows.Count, "J").End(xlUp).Row
Dim i As Long, j As Long, k As Long
Dim Tgt1 As Range
Set Tgt1 = Target(1)
k = 12
For j = 32 To 179 Step 3
Set Tgt1 = Range(Cells(45, j), Cells(lRow, j))
i = Sheets("型式.部品情報設定").Cells(k, 30)
If Not Intersect(Target, Tgt1) Is Nothing Then
Select Case Tgt1.Value
Case "入庫"
Tgt1.Resize(1, 3).Interior.Color = RGB(152, 251, 152)
Tgt1.Font.Color = RGB(0, 0, 0)
If Tgt1.Offset(-i, 0).Value = "" Then
Tgt1.Offset(-i, 0).Interior.Color = RGB(255, 230, 230)
End If
Case "発注"
Tgt1.Resize(1, 3).Interior.ColorIndex = 0
Tgt1.Font.Color = RGB(255, 0, 0)
Tgt1.Font.Bold = True
Case "棚卸"
Tgt1.Resize(1, 3).Interior.Color = RGB(250, 215, 250)
Tgt1.Font.Color = RGB(0, 0, 0)
Case "取消"
Tgt1.Resize(1, 2).ClearContents
Tgt1.Resize(1, 3).Interior.ColorIndex = 0
If Tgt1.Offset(-i, 0).Interior.ColorIndex = xlNone Then
Else
Tgt1.Offset(-i, 0).Interior.ColorIndex = 0
Tgt1.Resize(1, 2).ClearContents
Tgt1.Resize(1, 3).Interior.ColorIndex = 0
End If
End Select
End If
k = k + 1
Next j
[返信 14] Re : Changeイベントでうまく行かず困っております
投稿者 : さんこう 投稿日時 : 2023/08/11(Fri) 14:43:10
＞「実行時エラー13 型が一致しません」とエラーになります。
「Select Case Tgt1.Value」となっていますが、
「Tgt1」は、これ↓に変えてしまっているので、
「入庫」とかとは違うものになっています。
Set Tgt1 = Range(Cells(45, j), Cells(lRow, j))
ここ↑は、違う変数名（例えば「TgtArea」とか）にして、
ここ↓も修正しましょう。
If Not Intersect(Target, Tgt1) Is Nothing Then
↓
If Not Intersect(Tgt1, TgtArea) Is Nothing Then
＞「実行時エラー13 型が一致しません」とエラーになります。
「Select Case Tgt1.Value」となっていますが、
「Tgt1」は、これ↓に変えてしまっているので、
「入庫」とかとは違うものになっています。
Set Tgt1 = Range(Cells(45, j), Cells(lRow, j))
ここ↑は、違う変数名（例えば「TgtArea」とか）にして、
ここ↓も修正しましょう。
If Not Intersect(Target, Tgt1) Is Nothing Then
↓
If Not Intersect(Tgt1, TgtArea) Is Nothing Then
[返信 15] Re : Changeイベントでうまく行かず困っております
投稿者 : たけ 投稿日時 : 2023/08/13(Sun) 08:40:25
■[返信 14] さんこうさん（2023-08-11 14:43:10）の記事
＞ ＞「実行時エラー13 型が一致しません」とエラーになります。
＞
＞ 「Select Case Tgt1.Value」となっていますが、
＞
＞ 「Tgt1」は、これ↓に変えてしまっているので、
＞ 「入庫」とかとは違うものになっています。
＞
＞ Set Tgt1 = Range(Cells(45, j), Cells(lRow, j))
＞
＞ ここ↑は、違う変数名（例えば「TgtArea」とか）にして、
＞
＞ ここ↓も修正しましょう。
＞
＞ If Not Intersect(Target, Tgt1) Is Nothing Then
＞
＞ ↓
＞
＞ If Not Intersect(Tgt1, TgtArea) Is Nothing Then
＞
＞
＞
修正して実行したところ、「実行時エラー13 型が一致しません」
は出なくなりましたが、iの値で変化する背景色が反映されない、
反映されるがiの値がおかしい（ローカルウィンドウの値と違う）
です。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow As Long
lRow = Cells(Rows.Count, "J").End(xlUp).Row
Dim i As Long, j As Long, k As Long
Dim Tgt1 As Range
Set Tgt1 = Target(1)
k = 12
For j = 32 To 179 Step 3
Set TgtArea = Range(Cells(45, j), Cells(lRow, j))
i = Sheets("型式.部品情報設定").Cells(k, 30)
If Not Intersect(Tgt1, TgtArea) Is Nothing Then
Select Case Tgt1.Value
Case "入庫"
Tgt1.Resize(1, 3).Interior.Color = RGB(152, 251, 152)
Tgt1.Font.Color = RGB(0, 0, 0)
If Tgt1.Offset(-i, 0).Value = "" Then
Tgt1.Offset(-i, 0).Interior.Color = RGB(255, 230, 230)
End If
Case "発注"
Tgt1.Resize(1, 3).Interior.ColorIndex = 0
Tgt1.Font.Color = RGB(255, 0, 0)
Tgt1.Font.Bold = True
Case "棚卸"
Tgt1.Resize(1, 3).Interior.Color = RGB(250, 215, 250)
Tgt1.Font.Color = RGB(0, 0, 0)
Case "取消"
Tgt1.Resize(1, 2).ClearContents
Tgt1.Resize(1, 3).Interior.ColorIndex = 0
If Tgt1.Offset(-i, 0).Interior.ColorIndex = xlNone Then
Else
Tgt1.Offset(-i, 0).Interior.ColorIndex = 0
Tgt1.Resize(1, 2).ClearContents
Tgt1.Resize(1, 3).Interior.ColorIndex = 0
End If
End Select
End If
k = k + 1
Next j
■[返信 14] さんこうさん（2023-08-11 14:43:10）の記事
＞ ＞「実行時エラー13 型が一致しません」とエラーになります。
＞
＞ 「Select Case Tgt1.Value」となっていますが、
＞
＞ 「Tgt1」は、これ↓に変えてしまっているので、
＞ 「入庫」とかとは違うものになっています。
＞
＞ Set Tgt1 = Range(Cells(45, j), Cells(lRow, j))
＞
＞ ここ↑は、違う変数名（例えば「TgtArea」とか）にして、
＞
＞ ここ↓も修正しましょう。
＞
＞ If Not Intersect(Target, Tgt1) Is Nothing Then
＞
＞ ↓
＞
＞ If Not Intersect(Tgt1, TgtArea) Is Nothing Then
＞
＞
＞
修正して実行したところ、「実行時エラー13 型が一致しません」
は出なくなりましたが、iの値で変化する背景色が反映されない、
反映されるがiの値がおかしい（ローカルウィンドウの値と違う）
です。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow As Long
lRow = Cells(Rows.Count, "J").End(xlUp).Row
Dim i As Long, j As Long, k As Long
Dim Tgt1 As Range
Set Tgt1 = Target(1)
k = 12
For j = 32 To 179 Step 3
Set TgtArea = Range(Cells(45, j), Cells(lRow, j))
i = Sheets("型式.部品情報設定").Cells(k, 30)
If Not Intersect(Tgt1, TgtArea) Is Nothing Then
Select Case Tgt1.Value
Case "入庫"
Tgt1.Resize(1, 3).Interior.Color = RGB(152, 251, 152)
Tgt1.Font.Color = RGB(0, 0, 0)
If Tgt1.Offset(-i, 0).Value = "" Then
Tgt1.Offset(-i, 0).Interior.Color = RGB(255, 230, 230)
End If
Case "発注"
Tgt1.Resize(1, 3).Interior.ColorIndex = 0
Tgt1.Font.Color = RGB(255, 0, 0)
Tgt1.Font.Bold = True
Case "棚卸"
Tgt1.Resize(1, 3).Interior.Color = RGB(250, 215, 250)
Tgt1.Font.Color = RGB(0, 0, 0)
Case "取消"
Tgt1.Resize(1, 2).ClearContents
Tgt1.Resize(1, 3).Interior.ColorIndex = 0
If Tgt1.Offset(-i, 0).Interior.ColorIndex = xlNone Then
Else
Tgt1.Offset(-i, 0).Interior.ColorIndex = 0
Tgt1.Resize(1, 2).ClearContents
Tgt1.Resize(1, 3).Interior.ColorIndex = 0
End If
End Select
End If
k = k + 1
Next j
[返信 16] Re : Changeイベントでうまく行かず困っております
投稿者 : さんこう 投稿日時 : 2023/08/13(Sun) 09:28:34
＞iの値で変化する背景色が反映されない、
＞反映されるがiの値がおかしい（ローカルウィンドウの値と違う）
もう少し具体的に表現してみましょう。
例えば、↓のように。
セルAF50を「入庫」にしたとき
「i」の値が２なので
セルAF48の背景色が変化するはずなのに、変化しない
（あるいは、別のセル（具体的に表記）が変化する）
＞iの値で変化する背景色が反映されない、
＞反映されるがiの値がおかしい（ローカルウィンドウの値と違う）
もう少し具体的に表現してみましょう。
例えば、↓のように。
セルAF50を「入庫」にしたとき
「i」の値が２なので
セルAF48の背景色が変化するはずなのに、変化しない
（あるいは、別のセル（具体的に表記）が変化する）
[返信 17] Re : Changeイベントでうまく行かず困っております
投稿者 : たけ 投稿日時 : 2023/08/21(Mon) 22:13:26
■[返信 16] さんこうさん（2023-08-13 09:28:34）の記事
＞ ＞iの値で変化する背景色が反映されない、
＞ ＞反映されるがiの値がおかしい（ローカルウィンドウの値と違う）
＞
＞ もう少し具体的に表現してみましょう。
＞
＞ 例えば、↓のように。
＞
＞ セルAF50を「入庫」にしたとき
＞ 「i」の値が２なので
＞ セルAF48の背景色が変化するはずなのに、変化しない
＞ （あるいは、別のセル（具体的に表記）が変化する）
＞
＞
＞
さんこう先生
すみません、説明が悪く申し訳ありませんでした。
そして、返信が拒否され続けてしばらく返信できませんでした。すみません。
御礼が言えないので、新しく投稿しようかと思いましたが投稿も拒否されてしまいました。
TgtAreaで「入庫」を繰り返していると
背景が変更されていないセルに規則性があることに気づき
日付データの表示を終日表示に切り替えるボタンを作り、週日表示としていたため
非表示の土日行にセルの背景色が反映されていたことに気が付きました。
先生が丁寧に教えてくださったコードはきちんと動いていたのに
本当に申し訳ありませんでした。
ご迷惑をおかけしましたが、これでChangeイベントでうまく行かなかった
事が解決しました。ありがとうございます！
■[返信 16] さんこうさん（2023-08-13 09:28:34）の記事
＞ ＞iの値で変化する背景色が反映されない、
＞ ＞反映されるがiの値がおかしい（ローカルウィンドウの値と違う）
＞
＞ もう少し具体的に表現してみましょう。
＞
＞ 例えば、↓のように。
＞
＞ セルAF50を「入庫」にしたとき
＞ 「i」の値が２なので
＞ セルAF48の背景色が変化するはずなのに、変化しない
＞ （あるいは、別のセル（具体的に表記）が変化する）
＞
＞
＞
さんこう先生
すみません、説明が悪く申し訳ありませんでした。
そして、返信が拒否され続けてしばらく返信できませんでした。すみません。
御礼が言えないので、新しく投稿しようかと思いましたが投稿も拒否されてしまいました。
TgtAreaで「入庫」を繰り返していると
背景が変更されていないセルに規則性があることに気づき
日付データの表示を終日表示に切り替えるボタンを作り、週日表示としていたため
非表示の土日行にセルの背景色が反映されていたことに気が付きました。
先生が丁寧に教えてくださったコードはきちんと動いていたのに
本当に申し訳ありませんでした。
ご迷惑をおかけしましたが、これでChangeイベントでうまく行かなかった
事が解決しました。ありがとうございます！
当掲示板について
- Excel VBA に関する掲示板です。Excel VBA に関する質問や疑問、それに対する解決方法など気軽に投稿してください。
- 記事内ではHTMLのタグは使用できません。
- 記事は一度投稿すると修正できません。内容を訂正したい場合は返信で対応してください。
- Sub〜End Sub、Function〜End Function は自動的にプログラムコードとみなし、枠で囲って見やすくします。
- Excel VBA とは関係ないことや、他人が不快に思うようなことなど、管理人が適当でないと判断した記事は削除する場合があります。
スポンサーリンク
返信入力フォーム
( 処理日時 : 2026-04-05 01:32:15 )