お久しぶりの投稿です。
今回はVBA( Visual Basic for Applications )を使って、やってみたかったことがあったので、この休日を利用してチャレンジしてみました。
やりたいこと
- 作業日と同じ日にちが入力されたセルがある場合、その行を削除する
コード
Sub 同時刻の行削除()
Dim td As Date
Dim retMsg As Integer
Dim cntLine As Integer
Dim lRow As Long
Dim i As Long
'現在日付(YYYY/MM/DD)
td = Date
'日付検索
cntLine = WorksheetFunction.CountIf(Range("A1048576:GG1"), td)
'日付を含む行が1件以上あった場合
If cntLine > 0 Then
retMsg = MsgBox(td & "(行数:" & cntLine & ")" & vbNewLine & "既に同日が存在します。" & vbNewLine & "削除してもよろしいでしょうか?", vbYesNoCancel + vbExclamation)
'ダイアログで「はい」が押下された場合
If retMsg = 6 Then
lRow = Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
'行削除
For i = lRow To 1 Step -1
If Cells(i, 1).Value = td Then
Range(i & ":" & i).Delete
End If
Next i
Application.ScreenUpdating = True
MsgBox "削除しました"
End If
Else
MsgBox "同時刻の行はありませんでした。"
End If
End Sub
- 作業日の日付を取得 (動画では2020/8/8)
- シート内で作業日日付を含むセルの行数をカウント
- 2で1件以上検索対象の行あった場合以下処理へ進む
- ダイアログで行を削除するか確認
- 4でOKが押下された場合以下処理へ進む
- 最終行から対象セル(動画では2020/8/8)を含む行を削除する
コメント