エクセルで日付を付けるマクロ

質問

エクセルで記入のある行のみに最後の列に日付を加えたいのですが、例えば1～１０までのＡからＥまで記入されていたとするとＦ１～Ｆ１０までに日付が入るようにしたいのですが、できればこのマクロが可能でしたらどなたかご教授下さい。

またスペースのための未記入行をまとめて削除する方法（できればマクロ）ももしご存知の方お願い致します。

回答No.4

Wendy02 · ベストアンサー

こんにちは。Wendy02です。

返事をつけていただいてありがとうございます。そこに結びつけるロジックというものも、また、ありませんが、奇妙に繋がったので、いっしょにしてしまいました。（^^;

Sub EnterDateFColumn()
　'F列に入れる
　 Dim rng As Range
　 Dim i As Long
　 Dim myDate As Date
　 Const DATE_FORMAT As String = "mm/dd" '日付の書式
　 myDate = Date
　 With Range("A1", Range("A65536").End(xlUp)).Offset(, 5)
　　　.NumberFormatLocal = DATE_FORMAT
　　　.Value = myDate
　 End With
End Sub

Sub EnterBlankRowDelete()
　'ブランク行を削除
　 Dim rng As Range
　 Dim i As Long
　 Set rng = Range("A1", Range("A65536").End(xlUp))
　 Application.ScreenUpdating = False
　 For i = rng.Rows.Count To 1 Step -1
　　　With rng.Cells(i).EntireRow
　　　　 If Application.CountA(.Value) = 0 Then
　　　　　　.EntireRow.Delete
　　　　 End If
　　　End With
　 Next
　 Set rng = Nothing
　 Application.ScreenUpdating = True
End Sub

なお、ご自身でマクロを作るようになるには、ブランク行を削除する場合は、だいたい、似たようなものになり、参考になるかと思いますが、F列に日付を入れるほうのマクロは、少し特殊ですから、あまり参考にはならないと思います。

回答No.5

moon00

補足をいただいたので修正しました。
まず日付記入の方から
ここから------------------------
Sub hikinyu()
Dim i As Integer
Dim j As Integer
Dim k As Integer

i = Range("a65536").End(xlUp).Row 'データ最終行番号を取得
Range("A1").CurrentRegion.Select
k = Selection.Columns.Count
Range("A1").Select

For j = 1 To i 'データ行数まで繰り返し
Cells(j, k + 1).Value = Date 'データの最終列のとなりに日付を記入
Next

End Sub
------------------------------ここまで
データが入っている領域の一番左のセルの隣に左に日付を記入します。

次は未記入行の削除ですが、A列にデータがない行を未記入行と
みなしています。
------------------------------ここから
Sub sakujo()
Dim i As Integer
Dim j As Integer

i = Range("a65536").End(xlUp).Row 'データ最終行番号を取得

For j = 1 To i 'データ行数まで繰り返し
If Cells(j, 1).Value = "" Then 'A列にデータがあるか判別
Cells(j, 1).Select 'データがなければセルを選択
Selection.EntireRow.Delete '選択したセルのある行を削除
End If
Next

End Sub
----------------------------ここまで
こんな感じでいかがでしょうか。

回答No.3

Wendy02

こんばんは。

日付を入れるマクロとスペースのための未記入行の削除は、抱き合わせなのですか？
そうすると、「エクセルで記入のある行のみに最後の列に日付を加えたい」がつながりますので、いっしょにしてしまいました。

'どこでも貼り付け可能
'---------------------------------

Sub EnterDateLastColumn()
　 Dim rng As Range
　 Dim i As Long
　 Dim myDate As Date
　 Const DATE_FORMAT As String = "mm/dd" '日付の書式
　 myDate = Date
　 Set rng = ActiveSheet.UsedRange
　 Application.ScreenUpdating = False
　 For i = rng.Rows.Count To 1 Step -1
　　　With rng.Cells(i, 256).End(xlToLeft)
　　　　 If Not IsEmpty(.Value) Then
　　　　　　.Offset(, 1).NumberFormatLocal = DATE_FORMAT
　　　　　　.Offset(, 1).Value = myDate '日付を入れる
　　　　　　Else
　　　　　　.EntireRow.Delete 'ブランク行を削除
　　　　 End If
　　　End With
　 Next
　 Application.ScreenUpdating = True
End Sub

'---------------------------------

お礼

ありがとうございました！早速試してみたのですが、自分の説明が悪く複雑なことを言ってしまってようで申し訳ないのです。
同一の列に日付を入れたいのですが、データは部分的に抜けてるのもありますがＡ列には必ず入力されていますのでシンプルにＡ１からＡ１０までデータが入力されていたらＦ１～Ｆ１０までに日付が入るようになれば大丈夫です。それとスペースのための未記入行の削除は別ということでお願いします。
自分の説明が悪くせっかくつくっていただいたのに大変申し訳ありません。ご面倒をお掛けしますが何卒宜しくお願い致します。

回答No.2

moon00

こんな感じでしょうか。
--------------------ここから
Sub hikinyu()
Dim i As Integer
Dim j As Integer

i = Range("a65536").End(xlUp).Row 'データ最終行番号を取得
For j = 1 To i 'データ行数まで繰り返し
Cells(j, 256).End(xlToLeft).Offset(0, 1).Value = Date 'データの最終列のとなりに日付を記入
Next

End Sub
---------------------------------ここまで
A列にデータが入っている行を対象としています。

二つ目はよく意味が分からないのですが・・・
未記入行というのは、どういうものなのでしょうか。
補足をお願いします。

お礼

ありがとうございました。試してみたのですが、自分の説明が悪く複雑なことを言ってしまってようで申し訳ないです。
同一の列に日付を入れたいのでＡ行にデータがある場合にＦ列に統一して日付が入るようになれば大丈夫です（今回の例だとＦ１～Ｆ１０）。

それとスペースのための行は例えば１～５行がデータ入り、一行未記入行を置いて７～１０行データ入りとなった時に６行目を削除するようなマクロになります。
自分の説明が悪くせっかくつくっていただいたのに大変申し訳ありませんが何卒宜しくお願い致します。

回答No.1

hana_222

削除する方法はわかりませんが…

Sub main()

For index_1 = 1 To 10

If Cells(index_1, 1) & Cells(index_1, 2) & Cells(index_1, 3) & Cells(index_1, 4) & Cells(index_1, 5) <> "" Then
Cells(index_1, 6) = Date
End If

Next index_1

End Sub