ドラッグした際のエラー回避
以下のようなVBAを組んだのですが、オートフィルタでV列をリストのいずれかを選択中にドラッグすると「型が一致しません」というエラーを起こします。
最悪、オートフィルタ中はドラッグ不可でもかまいません。
ご教授ください。
（WiｎXp/Access2003)
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'列の色変更
Dim myColor As Variant
Dim myFontColor As Variant
If Target.Column = 1 Then GoTo S
If Target.Column = 9 Then GoTo K
If Target.Column = 25 Then GoTo Y
If Target.Column = 22 Then GoTo A
If Selection.Cells.Count > 1 Then Exit Sub
Exit Sub
S:
'A列入力時
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Target.Value <> "" And Target.Offset(0, 4) = "" And Target.Offset(0, 2) = "" Then
Target.Offset(0, 2) = "TypeA"
Target.Offset(0, 5) = "未"
Target.Offset(0, 6) = Date
Target.Offset(0, 1).Select
End If
Application.EnableEvents = True
Exit Sub
K:
'故障入力時
If Not Intersect(Target, Range("K1:K10")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Target.Value = "Y" Then
Target.Offset(0, 13) = "故障"
Cells(Target.Row, 1).Resize(1, 28).Interior.ColorIndex = 7
Target.Offset(0, 1).Select
Else
End If
Application.EnableEvents = True
Exit Sub
Y:
'Y列入力時
If Not Intersect(Target, Range("Y1:Y10")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Target.Value <> "" And Target.Offset(0, 1) = "" And Target.Offset(0, 2) = "" Then
Target.Offset(0, -3) = "売却済"
Target.Offset(0, 1) = Date
Target.Offset(0, 2) = "未"
Cells(Target.Row, 1).Resize(1, 28).Interior.ColorIndex = 16
Else
End If
Application.EnableEvents = True
Exit Sub
A:
If Not Intersect(Target, Range("A1:AB10")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Select Case Target.Value
Case "故障"
myColor = 7 'ピンク
myFontColor = 1
Case "修理中"
myColor = 37 '薄い水色
myFontColor = 1
Case "担当出(1)"
myColor = 3 '赤
myFontColor = 1
Case "担当出(2)"
myColor = 8 '水色
myFontColor = 1
Case "担当出(3)"
myColor = 4 '蛍光緑
myFontColor = 1
Case "担当出(4)"
myColor = 6 '黄色
myFontColor = 1
Case "担当出(5)"
myColor = 5 '青
myFontColor = 1
Case "担当出(6)"
myColor = 10 '深緑色
myFontColor = 1
Case "売却済"
myColor = 16 '濃灰色
myFontColor = 1
Case "廃棄", "修理不可能"
myColor = 47 '群青
myFontColor = 2 '白
Case "保守用"
myColor = 49 '群青
myFontColor = 2 '白
Case Else
myColor = xlNone
End Select
Cells(Target.Row, 1).Resize(1, 28).Interior.ColorIndex = myColor
Cells(Target.Row, 1).Resize(1, 28).Font.ColorIndex = myFontColor
Application.EnableEvents = True
End Sub
Private Sub AFall()
If ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
End Sub
お礼
早速の回答をありがとうございました。 無事解決いたしました、