こんな空白入力マクロありますか

質問

OS:WinXp、Excel2002を使っています。下のようなデ－タがあり
60行目の処理を終えたら3行目から60行目まで同じ日付が自動的に入り、別の日に100行目の処理が終わったときに61～100行目まで処理日が自動的に入るようにしたいのですが？
処理行数が500行ぐらいある場合コピ－ではちょっと面倒かなと思いマクロでしたいのですが
A列　 B C・・・・H(日付)
１ 　　　　 　　　　 3/1　　　　 　
２　　　　　　　　　 3/1
３　　　　　　　
４
・
60
・
100
・
・

回答No.7

noname#95859

ANo.6 を見直しをしたところ、結構、至らない部分がありました。
修正版です。
前提：
B列には、名前を入る。
H列には、日付を入れる。
InputBoxにより、印刷範囲をユーザに入力させる。
この時の、ルールは、「印刷開始番号 - 印刷終了番号」とする。
印刷番号は、3行目が1番になるようなものである。
日付は、H列の日付未入力行から、B列の最終行までの範囲で自動入力する。

印刷範囲がまともであれば、日付を入力した上で、印刷範囲をプリンタに送る。

ここで、「まとも」の定義は、「印刷開始番号＜＝印刷終了番号」。

その他：
B列の最終行　＜　H列の日付未入力行
　これが、起きるのは、B列の名前を削除した時、この時には、
　B列の削除した分だけ、C、D,E,F,G,H列でも削除する。

InputBoxへの入力で、「-」を含まない場合、何もしない。
InputBoxへの入力で、印刷開始行を入れなかった場合、デフォルトで、番号１を与える。
InputBoxへの入力で、印刷終了行を入れなかった場合、デフォルトで、B列最終行を与える。
InputBoxへの入力で、意味不明な印刷開始行、或いは印刷終了行を与えた場合、デフォルトで、それぞれ、番号１、B列最終行を与える。

コードの中には、コメントを入れて置きましたので、参考になるものと思います。

----------------------------------------------------
Sub test()
Dim myCode As Variant
Dim S_rowpos_P As Variant
Dim E_rowpos_P As Variant
Dim S_rowpos_D As Integer
Dim E_rowpos_D As Integer
Dim hani_P As String
Dim Deleterequest_D As Boolean

Deleterequest_D = False
myOffset = 2
myCode = Application.InputBox("プリントする範囲(A列での番号）を入力してください" & vbCr & vbCr & "例　10-20", "仕事")
If myCode <> False And InStr(myCode, "-") > 0 Then '入力の大前提は　”－”を含むこと
'入力　開始ポジション解析------------------------------------------------
If InStr(myCode, "-") > 1 Then S_rowpos_P_L = Trim(Mid(myCode, 1, InStr(myCode, "-") - 1)) Else S_rowpos_P_L = 1
'開始行相当が入っていれば、その部分をピックアップ、入っていなければ代わりに1を入力
If Not IsNumeric(S_rowpos_P_L) Then S_rowpos_P_L = 1 '開始行相当の部分が数値でなければ1とする
S_rowpos_P = S_rowpos_P_L + myOffset 'テキスト数字を計算可能な数値に変換 および、実行番号に変換

'入力　終了ポジション解析------------------------------------------------
Alt_E_rowpos_P = Cells(65536, 2).End(xlUp).Row 'B列入力最終行
If InStr(myCode, "-") < Len(myCode) Then E_rowpos_P_L = Trim(Mid(myCode, InStr(myCode, "-") + 1)) Else E_rowpos_P_L = Alt_E_rowpos_P - myOffset
'終了行相当が入っていれば、その部分をピックアップ、入っていなければB列入力最終行を代わりに入力
If Not IsNumeric(E_rowpos_P_L) Then E_rowpos_P_L = Alt_E_rowpos_P - myOffset
'終了行相当の部分が数値でなければ,B列入力最終行を代わりに入力
E_rowpos_P = E_rowpos_P_L + myOffset 'テキスト数字を計算可能な数値に変換
If E_rowpos_P >= Alt_E_rowpos_P Then E_rowpos_P = Alt_E_rowpos_P
'終了ポジションがB列入力最終行より大きい場合、代わりにB列入力最終行とする
hani_P = Range(Cells(S_rowpos_P, 1), Cells(E_rowpos_P, 8)).Address

'日付入力の対象エリヤの解析（日付入力開始行、終了行の決定）
S_rowpos_D = Cells(65536, 8).End(xlUp).Offset(1, 0).Row 'H列未入力行を求める
If S_rowpos_D <= 3 Then S_rowpos_D = 3 'ヘッダーが消えている等で、3より小さな値であれば、３とする
E_rowpos_D = Alt_E_rowpos_P 'B列入力最終行
If S_rowpos_D <= E_rowpos_D Then
hani_D = Range(Cells(S_rowpos_D, 8), Cells(E_rowpos_D, 8)).Address '日付入力の対象エリヤ
Else
Deleterequest_D = True
End If
If S_rowpos_P <= E_rowpos_P Then '印刷指示の開始行、終了行がまともであれば実行
If Deleterequest_D = False Then
'B列最終行とH列最終行の関係がまともであれば、日付を入力
Range(hani_D).Value = Date
Else
'B列最終行とH列最終行の関係がまともでない（B列の入力が意図的に消されている場合）には、
'その他の入力も削除する
DeleteArea = Range(Cells(Alt_E_rowpos_P + 1, 2), Cells(S_rowpos_D, 8)).Address
Range(DeleteArea).ClearContents
End If

'日付を入力処理をした後で（削除も含む）、印刷のジョブを実行する----------------------------

Range(hani_P).Select
ActiveSheet.PageSetup.PrintArea = hani_P
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Else
Cells(3, 1).Select
'指示された印刷範囲がまともでない場合、何も実行されずに抜ける。
'この場合、以前に選択されたエリヤがそのまま残っていることになり、
'見た目、ワークシート上変化が無く、違和感を与えるので、特定セルを
'選択し直し、変化を与える。
End If
End If
End Sub

-----------------------------------------------
参考にしていただければ、幸いです。

回答No.6

noname#95859

こんな感じですか？
----------------
Sub test()
Dim myCode As Variant
Dim S_rowpos_P As Variant
Dim E_rowpos_P As Variant
Dim S_rowpos_D As Integer
Dim E_rowpos_D As Integer
Dim hani_P As String

myCode = Application.InputBox("プリントする範囲を入力してください" & vbCr & vbCr & "例　10-20", "仕事")
If myCode <> False And InStr(myCode, "-") > 0 Then
If InStr(myCode, "-") > 1 Then S_rowpos_P = Trim(Mid(myCode, 1, InStr(myCode, "-") - 1)) Else S_rowpos_P = 3
If Not IsNumeric(S_rowpos_P) Then S_rowpos_P = 3
If InStr(myCode, "-") < Len(myCode) Then E_rowpos_P = Trim(Mid(myCode, InStr(myCode, "-") + 1)) Else E_rowpos_P = Cells(65536, 1).End(xlUp).Row
If Not IsNumeric(E_rowpos_P) Then E_rowpos_P = Cells(65536, 1).End(xlUp).Row
S_rowpos_D = Cells(65536, 8).End(xlUp).Offset(1, 0).Row
If S_rowpos_D <= 3 Then S_rowpos_D = 3
E_rowpos_D = Cells(65536, 1).End(xlUp).Row
If S_rowpos_P <= E_rowpos_P Then
If S_rowpos_D <= E_rowpos_D Then Range(Cells(S_rowpos_D, 8), Cells(E_rowpos_D, 8)).Value = Date
hani_P = Range(Cells(S_rowpos_P, 1), Cells(E_rowpos_P, 8)).Address
Range(hani_P).Select
ActiveSheet.PageSetup.PrintArea = hani_P
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
End If
End Sub
------------------------------
入力として、正しくは、例にも示していますように、　１０－２０です。
しかし、実際は何でも構いません。アルファベットを入れても、それなりに動きます。この入力値は、プリント範囲に反映されます。
日付入力は、H列の未入力行から、B列の最後の入力行までです。
従って、日付入力範囲と、印刷範囲は、異なるロジックで決まります。
スクリプトが、内容の割りに長くなっているのは、ほとんどエラー対策のためです。

それなりに、デバッグはしてありますが、十分ではないかもしれません。
なにか、不具合があれば、その内容をお知らせください。

回答No.5

noname#95859

A.No4での修正です。
A列とB列、取り違えていました。
E_rowpos = Cells(1, 2).End(xlDown).Row
です。
念の為に、スクリプトを再度、示します。
Sub dateIn2()
Dim E_rowpos As Integer
E_rowpos = Cells(1, 2).End(xlDown).Row
If E_rowpos = 60 Then Range(Cells(3, 8), Cells(60, 8)).Value = Date
If E_rowpos = 100 Then Range(Cells(61, 8), Cells(100, 8)).Value = Date
If E_rowpos = 200 Then Range(Cells(101, 8), Cells(200, 8)).Value = Date
If E_rowpos = 300 Then Range(Cells(201, 8), Cells(300, 8)).Value = Date
If E_rowpos = 400 Then Range(Cells(301, 8), Cells(400, 8)).Value = Date
If E_rowpos = 500 Then Range(Cells(401, 8), Cells(500, 8)).Value = Date
End Sub

補足

Rich53さん早々に回答いただきありがとうございます。わたしの質問内容が悪くてすみません。
2行目A列：受付番号，B列:顧客氏名・・・H列(印刷日付)の入力デ－タ項目で、３行目が最初のデ－タ入力部分で、それ以降にデ－タの入力をしていき、ある程度デ－タがたまったときにリスト印刷(毎日印刷とは決まっていません)をするといった作業です。したがって
>60行目の処理を終えたら3行目から60行目まで
この６０行とか１００行とかは決まった数字ではありません。今回わかりやすくと思い出した数字であり、印刷する行数は(50件くらいのときもあれば、2∼300数十件など)不確定です。
そのためにMsgBoxを使って、入力する最初と最後の受付番号を尋ねる方法で最初と最後の受付番号の範囲全てのリスト印刷を考えています。
もちろんH列に日付が入るようにです。
すみません。よろしくお願いいたします。

回答No.4

noname#95859

こんな感じですかね。
-----------------------------------------------
Sub dateIn()
Dim E_rowpos As Integer
E_rowpos = Cells(1, 1).End(xlDown).Row
If E_rowpos = 60 Then Range(Cells(3, 8), Cells(60, 8)).Value = Date
If E_rowpos = 100 Then Range(Cells(61, 8), Cells(100, 8)).Value = Date
If E_rowpos = 200 Then Range(Cells(101, 8), Cells(200, 8)).Value = Date
If E_rowpos = 300 Then Range(Cells(201, 8), Cells(300, 8)).Value = Date
If E_rowpos = 400 Then Range(Cells(301, 8), Cells(400, 8)).Value = Date
If E_rowpos = 500 Then Range(Cells(401, 8), Cells(500, 8)).Value = Date
End Sub
-------------------------------------
VBAを用いれば、ほとんど、どんなこともできます。
しかし、スクリプトの中に、直接データ（例えば、60行目とか）を書き入れるのは、基本的に良くないです。スクリプトは、汎用性を持つべきものです。でないと、メンテナンスが発生します。全体の行数が1000行になったら、上記のスクリプトは使えません。スクリプトを作成する時には、常にメンテナンスのことを考えています（少なくとも小生は）。

当初の、案通りに、作成しましたが、60行目ぴったりの時点で、ボタンを押すのと、適当な行（入力し終えた行）の時点で、Hのセルをダブルクリックするのと、作業する人における負荷の差は余りありません。
しかし、案通りのスクリプトは、融通は効きません。61行目入力開始後、ぴったり100行まで行かないと・・・・、101行でもだめ。

そのように考えると、当初の案は、実用的ではない、と思います。
VBAを用いれば、大抵のことはできます。それ故、作業する人に余分な負荷をかけないような、作りをすることが、大切だと思います。

参考にしていただければ、幸いです。

回答No.3

noname#95859

マクロによる方法です。
考え方：イベントプロシージャをつかいます。
H列の任意のセルをダブルクリックすることをトリガとして、
そのセルより上の空白セルに日付を入力します。
「任意のセル（H列ですが）」をダブルクリックすることと、
当初の60行、100行とは、相容れません。従って、参考です。

下記のイベントプロシージャを該当のシートの裏にコピーしてください。
（標準モジュールではありません）
--------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim S_rowpos As Integer
If Target.Column <> 8 Then Exit Sub
S_rowpos = Target.End(xlUp).Offset(1, 0).Row
Range(Cells(S_rowpos, 8), Cells(Target.Row, 8)).Value = Date
End Sub

補足

Rich53さん早々の回答、コ－ドありがとうございます。
＞シートの裏にコピーしてください。
希望に近いのものがほとんどできました。
＞標準モジュールではありません
標準モジュ－ルでマクロボタンを使っては出来ないのですかね。
あとちょっとなんですけど

回答No.2

zap35

61行目から100行目までの処理が終わったら、H100セルを選択して
　Shift＋Ctrl＋上矢印キー
で連続した空白をまとめて選択します。（H61:H100が選択された状態になります）
次に日付を入力してCtrl＋Enterで選択した複数のセルに一度に日付を入力できます。
コピーでもそれほど面倒ではないと思いますが、上記方法ではいかがでしょうか。

もしマクロが良いならマクロを書くのは良いのですが、
＞60行目の処理を終えたら
何をもって「処理された」と判断すればよいのでしょうか。
具体的な記述がなければマクロも書けませんよ。

補足

zap35さん早々の回答ありがとうございます。
＞Ctrl＋Enterで選択した複数のセルに一度に日付を入力できます
一度に入力できないのはなぜでしょうか？やり方がおかしいのでしょうね。
＞何をもって「処理された」と判断すればよいのでしょうか
B列に名前がありここは確実に全て入力されています。他の列は空白の部分があります。コ－ドよろしければお願いします。

回答No.1

oguno

マクロではないですが、私が使っている方法を書きます。
よろしかったら参考にしてください。

●H2以降に下記数式を入力しておきます、
=IF(H2="","",H1)

●H1に当日日付をマニュアル入力する。
以降日付を変える（日付をマニュアル入力する）まで同じ日が表示されます。

●参考
日付を入力するのが案外面倒なので下記マクロで日付ボタンを作成しておきます。
　　ActiveCell.FormulaR1C1 = "=TODAY()"

マニュアル入力する代わりに、日付ボタンをクリックします。

●日付の書式は、お好み（必要な）の設定をしておいてください。