ドラッグした際のエラー回避
以下のような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
補足
早速のお返事有難うございます。 まったくの初心者なので質問もどうすれば良いか分からず困ってました。 Activecell.Offset(,1).Value= 早速試してみました。ホボ狙い通りです。 ただユーザーフォーム１から「完了」を入力するとユーザーフォーム２も同時に開いてしまいます。 その時にタブキーでカーソルを送ると狙い通りのセルに入らないので・・ アクティブになったセルの列のHに反映させるにはどうしたら良いか？ もしお時間があれば御教授願います。