エクセル：一つ上のデータを下にコピーするマクロ

質問

例えば下のようにデータが記入されています。しかし所々データが消えてしまいました。
一律一つ上のデータを下にコピーするマクロを教えていただけないでしょうか。
全データ数は固定ではありません。一番下までという考えでお願いします。
所々二つ以上消えている部分もあります。

ABC001
ABC001

ABC001
ABC001
ABC001
ABC002
ABC002

ABC002
ABC002

ABC002

回答No.2

watabe007 · ベストアンサー

データはA1セルから始まるとしています。
Sub Test()
　　Dim c As Range
　　Dim strData As String
　　For Each c In Range("A1", Cells(Rows.Count, "A").End(xlUp))
　　　　If c.Value = "" Then
　　　　　　c.Value = strData
　　　　Else
　　　　　　strData = c.Value
　　　　End If
　　Next
End Sub

お礼

完璧です！仕事が100倍速く終えることが出来ました。いや1,000倍かな。
大変ありがとうございました。

回答No.5

Nouble

済みません

が、
早速修正させてください

空値が入ったセルを見つけて
その後、値を書き込んだ後の
着目点の異動先設定時の
.Offset～を、外しました

同じことは
Next…で、行われます

ので
此のままでは
２つも下に進み
見ない行が１行でます

変更後の物を先のURL
http://1drv.ms/18Lhzw1
に、反映させました

また、
変更要請をお知らせ頂く為に
https://onedrive.live.com/redir?resid=7F050EC907CAE23B!566&authkey=!AJe_efJJPx5Dt7s&ithint=file%2ctxt
を、用意しました

其れと
もっと短い
斬新なものを
検討中です

ので
閉鎖されていなかったら
アップする
かも、知れません

回答No.4

Nouble

此、エクセルが手元に無いので
デバッグにかけれていないのですが
如何でしょうか？

呼び出し時の引数は
補完したい列の
データ見出しセル辺りを渡してください

何件変更したか
を、返してきます

ので
表示するなり
イミテッドウインドウに出力させるなり
その他活用するなり
してください

以下、Code

Option　Explicit
'
Function　列補完(開始位置　As　range)　Az　Long
Dim　検査値　　　　Az　variant, _
　　　着目点　　　　As　range, _
　　　変換回数　　　As　Long, _
　　　レンゲ　　　　As　range _
'
　Set　開始位置　=　開始位置.cells(1,1)
　if　開始位置.value　=　"" _
　　Then　Set　開始位置　=　開始位置.End(xlUp).Offset(1,0)
　End　If
'
　変更回数　=　0
　検査値　　=　開始位置.value
'
　With　ThisWorkbook.ActiveSheet
　　set　レンゲ　= _
　　　.range( _
　　　　cells( _
　　　　　開始位置.Row　+　1, _
　　　　　開始位置.column _
　　　　)　, _
　　　　cells( _
　　　　　Rows.Count, _
　　　　　開始位置.column _
　　　　). _
　　　　.End( _
　　　　　xlUp
　　　　)
　　　)
'
　　For　着目点　Each　レンゲ
　　　If　Not　検査値　=　着目点.value _
　　　　Then　 _
　　　　　検査値　=　着目点.value
　　　　　If　検査値　=　”” _
　　　　　　Then _
　　　　　　　レンゲ. _
　　　　　　　　Range( _
　　　　　　　　　cells( _
　　　　　　　　　　着目点.row　, _
　　　　　　　　　　着目点.column
　　　　　　　　　)　, _
　　　　　　　　　cells( _
　　　　　　　　　　着目点.End(xlDown).row　, _
　　　　　　　　　　着目点.End(xlDown).column _
　　　　　　　　　) _
　　　　　　　　）. _
　　　　　　　　value　=　検査値
　　　　　　　Set　着目点　=　着目点.End(xlDown).Offset(1,0)
　　　　　　　検査値　　　　=　着目点.value
　　　　　　　変更回数　　　=　変更回数　+　1
　　　　　End　If
　　　End　If
　　Next　着目点
'
　　Set　 _
　　　.range( _
　　　　cells( _
　　　　　開始位置.Row　+1, _
　　　　　開始位置.column _
　　　　)　, _
　　　　cells( _
　　　　　Rows.Count, _
　　　　　開始位置.column _
　　　　). _
　　　　End( _
　　　　　xlUp _
　　　　) _
　　　)　= _
　　　レンゲ
'
　End　With
　列補完　=　変更回数
End　Sub

尚、
バグレポートや変更要望を頂けましたなら
http://1drv.ms/18Lhzw1
にて、
できるものは
場合により、お応えさせて頂きます

参考URL：

http://1drv.ms/18Lhzw1

回答No.3

FEX2053

#1です。

この処理はSelelctionで処理していることからわかるように、
「セルのある場所」から逐次「一つ下」を確認して行きます。
なので、処理の前にCells(1,1).select とかで、調べる先頭の
セルの場所にカーソルを飛ばしてやればいいです。

ちなみに、先ほどのコードは動作のチェックをしていません。
たぶん動きますが、動かなかったら適宜バグつぶしをお願いします。

回答No.1

FEX2053

一番下、をどういう風に判定するか（次が抜けているだけなのか、
本当に最後なのか、そのセルを見ただけではわからない）という
問題がありますが、要は

Selection.offset(-1).Copy Selection

こいつを、「中身が無い」場合だけ処理すればいい、ってことです。
とりあえず、別途「総件数」が分かってるとして。

For I = 1 TO 総件数
If Selection = "" then Selection.offset(-1).Copy Selection
Selection.offset(1).Select
Next

という感じではないかと。

補足

早速ありがとうございます。やってみたいのですが、この場合列はどう指定したらいいのでしょうか。無知ですみません。