Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Target, Range("B2:C19")) Is Nothing Then
Cancel = True
Target.Formula = Date
End If

'E列のセルをダブルクリックした場合
If Target.Column = 5 Then
'D列の最終行を取得
Dim lastRow As Long
lastRow = Cells(Rows.Count, "D").End(xlUp).Row
'E列でクリックしたセルがD列の最終行と同じの場合には何もしない
If Target.Row <> lastRow Then
'セルの値をコピー
Target.Copy
'E列の空白のセルにペースト
Range("E3:E" & lastRow).SpecialCells(xlCellTypeBlanks).PasteSpecial xlPasteValues
'コピーを解除
Application.CutCopyMode = False
End If
'ダブルクリックのデフォルト動作をキャンセル
Cancel = True
End If

End Sub

2024-03-03

カテゴリ選択で時間表示

VBA

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
' 特定のセル範囲でダブルクリックされた場合の処理

　'A列をダブルクリックで時刻表示

If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then

Target.value = Now

Cancel = True ' ダブルクリック処理をキャンセル

End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
' 特定のセル範囲で値が変更された場合の処理

　　'C列をのセルに値が入ったら、B列とA列に時間を入れる

If Not Intersect(Target, Me.Range("C:C")) Is Nothing Then

Dim lastRow As Long

lastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row

Me.Cells(lastRow, "B").value = Now

Me.Cells(lastRow + 1, "A").value = Me.Cells(lastRow, "B").value

End If

End Sub

ばくがの業務効率化チャンネル

このブログは個人的なエクセルの備忘録です

リンク集

最終行まで削除

リンク設定

ダブルクリックでセルに値を入れる

カテゴリ選択で時間表示