エクセルのマクロ（指定列の空白にひとつ上の文字を入力し続ける）

エクセルのマクロを教えてください。
指定列の空白にひとつ上の文字を入力し続けるマクロです。

A列指定
A2からスタートし、1000行くらいあるデータ
空白があった場合ひとつ上の文字を入力
空白は、2行連続・3行連続となることもあるが大抵は1行空白
この場合、空白セルの上で一番近いデータをコピーする
A列のデータは、文字・数字・日付と様々
1000行ある場合もあるが、それ以下の場合もあるので、10行空白が続いたらマクロが自動的に終了
エクセル2003使用

よろしくお願いいたします。

No.1 ベストアンサー 回答者： rukuku 回答日時： 2008/02/20 05:31

はじめまして

＞空白があった場合ひとつ上の文字を入力
＞空白は、2行連続・3行連続となることもあるが大抵は1行空白
＞この場合、空白セルの上で一番近いデータをコピーする
＞A列のデータは、文字・数字・日付と様々
Ａ３から順にセルが空白でないかを調べていき、空白だったら上のセルをコピーすればＯＫです。…空白が何行か続いても空白行に上の行の値をコピーしてから次の行か空白がどうかチェックする様にすればＯＫです
サンプルプログラムは以下の通りです。
Sub sumple()
For i = 3 To 1000
If Cells(i, "A") = "" Then
Cells(i - 1, "A").Copy Cells(i, "A")
End If
Next i
End Sub

＞1000行ある場合もあるが、それ以下の場合もあるので、10行空白が続いたらマクロが自動的に終了
上のサンプルプログラムでは1000行を終了としています。終了の条件が「10行空白」ではなく、値が入っている最後の行とするなら、
For i = 3 To 1000
を
For i = 3 To [A65536].End(xlUp).Row
に置き換えれば出来ます。
ただし、A65536のセルに値が入っていないことが条件です。

この回答へのお礼

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

お礼日時：2008/02/24 00:33

No.3 回答者： Wendy02 回答日時： 2008/02/20 11:18

こんにちは。

>10行空白が続いたらマクロが自動的に終了
そういう注文は不必要な気もしますが、一応入れておきました。

ひとつずつセルに入れるのではなくて、以下のようにまとめてコピーします。

Sub TestMacro()
Dim a As Range
On Error GoTo ErrHandler
Application.ScreenUpdating = False
With Range("A2", Range("A1001").End(xlUp))
　For Each a In .SpecialCells(xlCellTypeBlanks).Areas
　　If a.Rows.Count < 10 Then
　　　a.Offset(-1).Cells(1).Copy a
　　Else
　　　Exit Sub　'10行の空白は、終了
　　End If
　Next a
End With
Application.ScreenUpdating = True
ErrHandler: 'すでに入れられている場合は終了
End Sub

この回答へのお礼

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

お礼日時：2008/02/24 00:33

No.2 回答者： rukuku 回答日時： 2008/02/20 05:35

サンプルプログラムの訂正です。

前に書き込んだプログラムでも動作しますがこちら方が記述が少し短くなります。

Sub sumple()
For i = 3 To [A65536].End(xlUp).Row
If Cells(i, "A") = "" Then Cells(i - 1, "A").Copy Cells(i, "A")
Next i
End Sub

この回答へのお礼

お返事ありがとうございました。
シンプルな点と使い勝手が一番良かったです。

お礼日時：2008/02/24 00:32