今日の日付の行だけ入力出来るようにする実験 Excel2000 VBA [Excel2000 VBA独習]
今日の日付の行だけ入力出来るようにする実験
前記事のつづき
今日の日付がある行を調べ、それ以外の行を選択したら選択していたセルに移動する。
選択セルに数式が設定されていれば、右に移動する。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Dim scope As Range
Dim today_row As Long
'今日の日付行
today_row = ActiveSheet.Cells.Find(Date).Row
'入力許可範囲の設定
Set scope = Range(Cells(today_row, 2), Cells(today_row, 255))
'選択セル判定
With Application
If .Intersect(Target, scope) Is Nothing _
Then
.EnableEvents = False
.PreviousSelections(1).Select '選択していたセルを選択
.EnableEvents = True
Else
.Goto ActiveCell
End If
End With
'数式セルは選択出来ないようにする(数式ならば右移動)
If Target.HasFormula = True Then Target.Offset(0, 1).Select
'セットの解除
Set scope = Nothing
End Sub
今日の日付がない場合の対処あり実験
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Dim scope As Range
Dim today_row As Long
'今日の日付行
today_row = ActiveSheet.Cells.Find(Date).Row
'今日の日付が無ければ
If today_row < 1 Then GoTo owari
'入力許可範囲の設定
Set scope = Range(Cells(today_row, 2), Cells(today_row, 255))
'選択セル判定
With Application
If .Intersect(Target, scope) Is Nothing _
Then
.EnableEvents = False
.PreviousSelections(1).Select 'Cells(today_row, 2).Select
.EnableEvents = True
Else
.Goto ActiveCell
End If
End With
'数式セルは選択出来ないようにする(数式ならば右移動)
If Target.HasFormula = True Then Target.Offset(0, 1).Select
'セットの解除
Set scope = Nothing
Exit Sub
owari:
Application.EnableEvents = False
MsgBox "今日の日付に該当するセルがありません。" & vbLf + vbLf & "シートイベントを無効にしました。"
End Sub
コメント 0