VBAでコードの編集が上手くいきません

質問

先日、ご回答頂いたコードを元に自分でいじっているのですが上手く行きません

自分が変更したコード

シート1→シート名：変更箇所

Private Sub worksheet_change(ByVal Target As Excel.Range)
If Target.Address <> "$C$40" Then Exit Sub
If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub
Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value

If Target.Address <> "$C$42" Then Exit Sub
If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub
Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value

If Target.Address <> "$C$44" Then Exit Sub
If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub
Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value

End Sub

シート2→シート名：リスト

Private Sub worksheet_change(ByVal Target As Excel.Range)
Dim i As Long, c As Long
Dim h As Range, ha As Range
Dim myDic As Object
Set ha = Application.Intersect(Target, Range("A:C"))
If ha Is Nothing Then Exit Sub
Set ha = Application.Intersect(ha.EntireColumn, Range("1:1"))

For Each h In ha
Set myDic = CreateObject("Scripting.Dictionary")
If h.Column = 1 Then c = 3 'A列→C列
If h.Column = 2 Then c = 4 'B列→D列
If h.Column = 3 Then c = 6 'C列→F列
On Error Resume Next
For i = 2 To Cells.SpecialCells(xlCellTypeLastCell).Row
If Cells(i, h.Column) <> "" Then
myDic.Add Cells(i, h.Column).Value, Cells(i, h.Column).Value
End If
Next i

With Worksheets("変更箇所").Cells(40, c).EntireColumn.Validation
.Delete
.Add Type:=xlValidateList, Formula1:=Join(myDic.keys, ",")
End With
Set myDic = Nothing
Next
End Sub

シート1において$C$40または$C$42または$C$44のいずれかを変更した場合
最後に変更したセルに対し、シート2にオートフィルタ―がかかる様にしたいと思っています。

試しにシート1を以下のように編集したところ、思った動作を行ったのですが
$C$40または$C$42または$C$44のいずれかのセルを空白にすると
エラーがでてしまいます。

Private Sub worksheet_change(ByVal Target As Excel.Range)
If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub
Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value

If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub
Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value

If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub
Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value

End Sub

Then Exit Subをどう編集すれば上手く動作するでしょうか？

回答No.1

keithin · ベストアンサー

所定のセル範囲に空白以外で記入したら，オートフィルタを掛け直します。

シート１：
private sub Wokrhseet_Change(byval Target as excel.range)
　dim h as range
　if application.intersect(target, range("C40:C45")) is nothing then exit sub
　worksheets("リスト").autofiltermode = false
　for each h in target
　if h.value <> "" then
　worksheets("リスト").range("A:C").autofilter field:=1, criteria1:=h.value
　end if
　next
end sub

＃シート２のマクロは，今回のご質問には無関係です

＃補足
Ｃ４０，Ｃ４２，Ｃ４４の３カ所のセルがあったとして，エクセルではそれらのセルを「同時に」書き換えることも「やろうと思えばできます」。
例えば３つのセルを選んで一斉にDeleteキーで削除するとか，一斉にCtrl+Enterで入力する（勿論これでは同じデータが記入されてしまいますけど）とか，どこかからデータをコピー貼り付けるとか。

いまマクロを検討しているアタマでは「１個のセルを書き換えたとき」という前提(想定)でマクロを書いていると思いますが，先にお話ししたような複数セルの同時操作といった「想定外の操作」でエラーにならないように，マクロの方は「出来ること全てに備えて（どのように動作すればよいのか考えておいて）」作成しなければいけません。

お礼

一旦、質問を閉め切り
再度質問させていただきます。
有難うございました。

補足

補足にて判りやすいご指導を頂き有難うございます。

今回のマクロを、前回のマクロを消して書きこんだのですが
何故かオートフィルタ―の掛け直しができなくなりました。
ちなみに、エラーも出ません。
どうしたら宜しいでしょうか？