ハピタス登録で1,000円分になるURL
家計簿の日付と曜日をセルに
完成図はコレ
セルの設定はこう
INDEX関数で翌日日付にする
こう
これで 2024/1/2 が表示される。
TEXT(日付セル,"aaa")で曜日が出る
ソース
Sub クリア_Click()
'MsgBox ("クリア")
' 確認メッセージを表示
Dim response As VbMsgBoxResult
response = MsgBox("本当にクリアしますか？", vbYesNo + vbQuestion, "確認")
'YESが選択された場合、バックアップを取ってからセルをクリア
If response = vbYes Then
'======作業前バックアップ
' 現在の日時を取得してフォーマット
Dim timestamp As String
timestamp = Format(Now, "YYYYMMDD_HHMMSS")
' 新しいファイル名を作成
Dim newFileName As String
newFileName = ThisWorkbook.Path & "\" & timestamp & "_2024パソコン用『新婦人の家計簿』シート保護パスなし_backup.xlsm"
' マクロファイルを保存
ThisWorkbook.SaveCopyAs newFileName
' 新しいファイルを開く
'Workbooks.Open newFileName
MsgBox "クリア前のバックアップ: " & newFileName, vbInformation, "保存完了"
'=====全てのSheetについてクリア処理
Dim ws As Worksheet
Dim sheetName As String
'1月から12月までのシートに対して繰り返し
For i = 1 To 12
' シート名を作成
sheetName = i & "月"
' シートが存在する場合、K5からK10までをクリア
If SheetExists(sheetName) Then
Set ws = Worksheets(sheetName)
ws.Range("D3:F4").ClearContents
ws.Range("K5:M10").ClearContents
ws.Range("K13:CY30").ClearContents
ws.Range("K33:CY67").ClearContents
ws.Range("K73:CY82").ClearContents
ws.Range("CZ39:DZ100").ClearContents
MsgBox i&"月のセルがクリアされました。", vbInformation, "完了"
End If
Next i
Else
MsgBox "キャンセルされました。", vbInformation, "キャンセル"
End If
End Sub
Function SheetExists(sheetName As String) As Boolean
' シートが存在するか確認する関数
On Error Resume Next
SheetExists = (Worksheets(sheetName).Name = sheetName)
On Error GoTo 0
End Function
