エクセル：マクロの起動条件

質問

お世話になります。
以下の条件でのマクロを起動する方法、及びそのマクロを教えてください。

《条件》
ブックを開いた時、あるシートのＣ列でデータが入っている最下行の行番号とＡ列のデータが入って最下行の行番号の差が１００以下だった場合、マクロを実行する。
（なおＣ列の行番号の方が必ず大きいです）

ちなみに実行したいマクロは１～６の手順です。
１．ブックを開いたとき
２．「入力用」という名前のシートのＣ列でデータが入っている最下行の行番号とＡ列のデータが入っている最下行の行番号の差が１００以下だった場合
３．「入力用」というシートにかかっているシートの保護をはずし
４．データが入っているＣ列の最下行のＡ～Ｚ列を選択して、５０行分　下にコピーする。
　（例えば、Ｃ列の最下行が３５０行の場合、Ａ３５０～Ｚ３５０まで　を選択したあと４００行まで下にコピーする。）
５．再度シートの保護をかけ
６．Ａ列でデータが入っている最下行の１つ下のセルを選択する

ちなみに、２の条件に当てはまらないときはマクロを実行しません。
またＣ列の最下行よりＡ列の最下行が大きい数字になることはないはずですが、もし同じかＡ列の方が大きい場合、「エラー：Ｃ列よりＡ列が大きくなっています」と画面に表示させたい。

なお、行番号の差：１００、選択するＡ～Ｚ行、５０行分下にコピー　は変わる可能性があるので、修正する場合どの部分を修正すればよいかも教えてください。

よろしくお願いします。

回答No.4

ham_kamo · ベストアンサー

No.1です。
フィルダウン（Ctrl+D）だったのですね。マクロを修正してみました。

　ActiveSheet.Unprotect

の下の、

　Range(Cells(ERowC, SCol), Cells(ERowC, ECol)).Copy Cells(ERowC + CopyTo, SCol)

を削除して、

　Range(Cells(ERowC, SCol), Cells(ERowC + CopyTo, ECol)).Select
　Selection.FillDown

に置きかえてください。

それから、もう一点私のミスがありました。

　ElseIf ERowC - ERowA > 100 Then

という行があるのですが、これは

　ElseIf ERowC - ERowA > DiffRows Then

の誤りです。（容易に数値を変更できるように、最初にパラメータを定義していたのに、それを使ってませんでした）

これで試していただけますか？

お礼

ありがとうございました。
期待通りの動きをしてくれました。

回答No.3

134

＃２ですが、Changeに勝手に変えてしまったのが敗因かもしれません。

chenge　セルを書き換えるとＶＢＡ起動
ということで、セルを追加する。
追加した結果、最終Ｃ行の行数とＡ行の行数が等しいので、１００以下を満たし、再びＶＢＡ起動…　というループを考えていました。

openなら、開いた瞬間に行を追加。書き換えて終了なので、問題ないのかもしれません。

でも、というか、やっぱり、コードの記述方法は、＃１様の方がすっきりして見返しやすいですね　＾＾；）

回答No.2

134

実はこの問題、結構やっかいなんじゃないかと思ったりします。
イベントプロシージャとしては、bookのopen　ではなく、sheetのchangeだろうと思うのですけど、

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

if range("A65535").end(xlup).row > range("C65535").end(xlup).row then msgbox("エラー：Ｃ列よりＡ列が大きくなっています",vbOKOnly)

if range("c65535").end(xlup).row - range("a65535").end(xlup).row <=100 then
workshhet("入力用").unprotect
Range(Range("C65535").End(xlUp).Offset(0, -2), Range("C65535").End(xlUp).Offset(0, 23)).Copy

Range(Range("c65535").End(xlUp).Offset(1, -2), Range("C65535").End(xlUp).Offset(50,23)).PasteSpecial xlPasteAll '後のoffset(50,23)の50を増減させるかも？

worksheet("入力用").protect
end if
range("A65535").end(xlup).select
End Sub

というのが、基本でしょうけど、ペーストした瞬間に、ＶＢＡの開始条件となり、無限ループに陥るように思います。

無限ループを回避する条件が、ちょっと思いつかないです。

お礼

ありがとうございました。

補足

ご回答ありがとうございます。正直考えの足りない部分がかなりあったようです。難しいことはわからないのですが、回答者さんの疑問については、５０行分を増やすのを１００以上にすれば解決するでしょうか？
また、閉じる際には「入力用」シートを選んだ上で上書き保存後閉じるというマクロを使っていますので、bookのopenで対応できるのかなという感じです。

回答No.1

ham_kamo

とりあえず書かれた通りに作ってみました。
Alt+F11でVBAの画面を開き、左のThisWorkbookをダブルクリックすると右に白い画面が新たに開くので、そこに以下のマクロをコピーして貼り付けてください。
なお、選択する列の左端Aと右端Z、50行分下にコピー、行番号の差100の部分は、最初の４行の該当する箇所を書き換えてください。

Private Sub Workbook_Open()
　Const SCol As String = "A" 'コピーする行の左端の列
　Const ECol As String = "Z" 'コピーする行の右端の列
　Const CopyTo As Integer = 50 'コピーする行の間隔
　Const DiffRows As Integer = 100 'A列とC列の最後の行番号の差
　Dim ERowA As Long, ERowC As Long

　Worksheets("入力用").Activate
　ERowA = Cells(Rows.Count, "A").End(xlUp).Row
　ERowC = Cells(Rows.Count, "C").End(xlUp).Row
　If ERowA > ERowC Then
　　MsgBox "エラー：Ｃ列よりＡ列が大きくなっています", vbExclamation
　　Exit Sub
　ElseIf ERowC - ERowA > 100 Then
　　Exit Sub
　End If
　ActiveSheet.Unprotect
　Range(Cells(ERowC, SCol), Cells(ERowC, ECol)).Copy Cells(ERowC + CopyTo, SCol)
　ActiveSheet.Protect
　Cells(ERowA + 1, "A").Select
End Sub

保存していったんブックを閉じ、再度開くとマクロが条件にしたがって実行されるはずです。
エラーが出たり、ご希望の動作と違うときは補足をお願いします。

補足

早速のご回答ありがとうございます。説明が少々足りませんでした。５０行下にコピーという点なのですが、質問の例だと３５０行目の内容を４００行目にコピーするのではなく、３５０行目から４００行目までを選択して　Ctrl＋D　を行うという意味です。