空白を埋めるマクロについて

質問

マクロで教えて下さい！

A B C D 　　　......
数量　名前　種類 購入者 　....
1 　2　　あ　　A
2　　　　く
3 5 DD
4　　　　　　　　　　まま
5　　　　さ
6　　　　　　　　　　ぱぱ

と右は何十項目・下は何千行と項目が続くデータがあります。
この空白に上の文字をコピーし埋めて行くマクロを作成するにはどうしたら良いでしょうか？
ただし以下の条件があります。

(1)D列の様に1行目が空白のセルは4行目の様に文字が入っている所までは空白のまま
(2)A列はそのファイルにより何行目までデータが入っているかは不明

A B C D 　　　
数量　名前　種類 購入者 　
1 　2　　あ　　A 　　　　　
2　 2　　く A
3 5 く DD
4　 5　　く DD 　　まま
5　 5　　さ DD まま
6　 5　　さ DD　 　ぱぱ

宜しくお願い致します。

回答No.8

Wendy02 · ベストアンサー

こんばんは。Wendy02です。

KenKen_SPさんへ

＞今までエラー値が原因となる失敗はなかったのですが、どんなときに失敗するのでしょう？

これは、ワークシートの場合は、配列変数は、Variant 型ですから、ワークシート上のエラー値でも入りますが、それ以外に、ワークシート上では、別のエラーを持っていることがあります。例えば、バイナリエディタで、その中をみると、まったくExcelとは関係のないデータが入り込んでいたりします。セルのオブジェクトから、Value プロパティに流し込めようとすると、異質なものとしてエラーが発生するのではないでしょうか？はっきりと断言できるわけではありませんが、Copy メソッドは、そういうものに直接触れずにできます。

＞Excelの場合は、物理メモリは関係ありません

この件は、たぶん、疑問になっているのかと思います。これは、私は、ずっと数年同じ考えでいます。実際にマイクロソフトなどのデータで、はっきりしたものではありません。

ExcelのVBAの場合は、バージョンごとに、その上限は違うようですが、Excelの割り当てられた仮想メモリが直接に影響を与えているのだと思っています。もちろん、コンパネからシステム－> [仮想メモリ]を大きくすれば、Excelの使用メモリは広がります。

＞配列数式を多用したり、VBA で大きな配列を使う場合などは物理メモリを消費するし、

それは、Excel全体での上限があって、そこから、配列に使用するメモリなどの割り振りがあるのだと思います。

配列変数のメモリの理論値は、途方もない大きさですが、私の計算では、数メガ程度しかないと思っています。（Excelの配列変数の仕様は、60次元ですが、その数値は、現実的ではありません。）

Excel 97 では配列の要素の最大数は 6,553 まででした。Excel 2000　以上は、名目的にはなくなりました。しかし、配列を利用したものは、Win98で、現実には、 SUM関数で、5,400個程度です。

仮に、5,500 個として、
1セルが、25 (標準 22 BYTE ) *5,500 =137,500
137,500 ÷1,024÷1,024 =0.13 M byte

あくまでも、Variant型でと考えた場合ですが、これで上限ということは、どう考えてもあり得ません。

これは、VBAでも、セルの配列を利用したものは、同じような制限があると考えています。（Excel 2002 では、通常の範囲ではエラーはないはずですが。）

また、別に、ファイルの大きさも、ブック全体の大きさよりも、ワークシートのセル自体の使い方などに依存することが多いです。セルには、複合的な要素があります。書式、数式、文字列など、それぞれに、メモリの割り振りがあり、それぞれに制限があるので、物理的メモリ自体を増やしても、よほどのことがない限りは、ほとんど影響を受けていないのではないか、と考えています。

※　メモリとして使用しているもの

・値を入れたセル　＋ 文字列
・書式設定の種類
・関数の参照範囲の種類（R1C1方式で見ると良く分ります）
・オブジェクト類（ブックを含む）
・フォントの種類
・１シートの計算過程で一時に使用するメモリ
・VBAのモジュールを格納する各々のプロシージャ
・アドイン、プリンタドライバ
・Excelで使われるユーティリティ

このようなものの中に割り振りされ細分化して、メモリの上限枠が存在しているのではないでしょうか？1つの例としては、書式の種類（組み合せ）の上限数が決められていますね。これは、あくまでも、私の推論ですが、そうしないと、説明がつかないことが出てくるように思いますが、いかがでしょうか？

何か、確証のない話で納得は出来ないでしょうけれども。

回答No.7

KenKen_SP

解決されたみたいで、よかったですね。あとは参考になってしまいますが、この機に Wendy02 さんに教えてほしいことがあります。

＞配列でエラーになるのは、エラー値が混入していることがありますね。

データ内にエラー値と数式がある可能性は考慮してました。その場合でも次のようなコードで、今までエラー値が原因となる失敗はなかったのですが、どんなときに失敗するのでしょう？

Dim BUF as Variant
BUF = rngTARGET.Value
rngTARGET.Value = BUF

んーー。。なら

BUF = rngTARGET.Value

の部分を

BUF = rngTARGET.Text

にしてみるとどうでしょうか？ これでもエラーになる可能性はありますか？
自分でテストする限りでは、Value も Text もエラーにならず、情報を得ることができません。教えて下さい。

＞Excelの場合は、物理メモリは関係ありません

ワークシートを増やしたり、配列数式を多用したり、VBA で大きな配列を使う場合などは物理メモリを消費するし、メモリが不足するとスワップが発生しそうな気がしますが、この場合も関係ないのでしょうか？
物理メモリが関係ない、、というのはどのような意味するところを教えて下さい。

今回はメモリではなく、CPU の処理速度かな？と考えてましたが、ご質問主様の PC スペックを見る限り、原因は別のところにありそうですね。

回答No.6

Wendy02

こんにちは。
Wendy02です。

＞データ量により、マクロが変わるんですか？知りませんでした。。

本来は、バージョンに依存しているのですが、一応、Excelのワークシートから取り出した配列変数は、正確に言うと多段階配列といいますが、これは、5,000個程度に留めておいたほうが、無難のようです。（これは、私個人のルールで、全ての人に当てはまるとはいいません）

純粋な1次元の配列変数は、もともと、データ型を決められるので、そのような制限は存在していませんし、もっと処理スピードも速いはずです。ところが、全部配列で処理すると、コードがややこしくなってしまうということがあります。

それと半分ジョークですが、

#　　まま
#　　ぱぱ

でしたので、そんなに多い量だと思いませんでした。(^^ゞ

私は、データ量によって、だいたい、3種類にコードを分けています。「最適化」といいますが、ほんのちょっとしたことで、処理スピードが速くなることもあります。

お礼

出来ましたぁ！！！頂いたコードをD列以降も処理出来る様に書き換え、無事完成致しました。本当に本当に本当にありがとうございました！！！！！もう、直接お会いしてお礼を言いたい位感謝の気持ちでいっぱいです！嬉涙

私は超ど初心者で書店の本を片手にマクロを勉強した為、参考書に載っていないコードはサッパリで全く応用が利きません。Wendy02さんの様に臨機応変にマクロを考えられる方達がとっても不思議なんですが、普通にキーボードを打って書いてるのですか？それとも何かソフトとか本とか簡単にマクロが組める優れツールとか持ってらっしゃるんですか？何か特別な勉強をされたのか、とかとっても疑問に思っちゃいます(笑)

回答No.5

Wendy02

こんにちは。
Wendy02です。

＞メモリの調べ方が分からないのですが、恐らく512はあったと思います。
Excelの場合は、物理メモリは関係ありませんが、

＞2000行弱、60列弱に空白以外は文字がびっしり書かれています。

これを知っていたら、そのようには作りませんでしたが、各列で範囲を取っているので、2000行で、メモリ枠でエラーが出る可能性は低いです。私の知っている限りですと、配列でエラーになるのは、エラー値が混入していることがありますね。たぶん、Copy ですと、エラー値もコピーできるような気がします。

一応、第2段のコードも用意はしていますが、一度、以下を試してみてください。

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

Sub BlankCellsEntering2()
　 Dim r As Range
　 Dim rb As Range
　 Dim cl As Range
　 Dim a As Variant
　 Dim MaxRow As Long
　 Dim c As Range
　 Application.ScreenUpdating = False

　 '最初の基点場所
　 '範囲の取得
　 For Each c In Range("A1:D1")
　　　If Cells(65536, c.Column).End(xlUp).Row > MaxRow Then
　　　　 MaxRow = Cells(65536, c.Column).End(xlUp).Row
　　　End If
　 Next
　 Set r = Range("A1").Resize(MaxRow, 4)

　 Application.ScreenUpdating = False
　 '縦切りで取る
　 For Each cl In r.Columns

　　　On Error Resume Next
　　　Set rb = cl.SpecialCells(xlCellTypeBlanks)
　　　On Error GoTo 0
　　　If Not rb Is Nothing Then
　　　　 For Each a In rb.Areas 'Areas で取る
　　　　　　With a
　　　　　　　 If .Row > r.Cells(2, 1).Row Then
　　　　　　　　 .Cells(1, 1).Offset(-1).Copy .Cells
　　　　　　　 End If
　　　　　　End With
　　　　 Next a
　　　End If
　 Next cl
　 Application.ScreenUpdating = True
　 Set rb = Nothing:　 Set r = Nothing
End Sub

お礼

早速のお返事ありがとうございます！お忙しい中私なんかの為に本当にありがとうございます。涙

データ量により、マクロが変わるんですか？知りませんでした。。言葉足らずで申し訳ございません。

頂いたもので試した所、凄いスピードでA～D列まで空白が埋まりました！

今まで出ていたエラーのマクロで、行数を大幅に減らして試したところ、そのデータファイルにもよるんですが、大体200～500行までですと正常に軌道してくれました。

回答No.4

KenKen_SP

こんにちは。KenKen_SP です。

面白そうなので、参加させて下さい。

Wendy02 さんのロジックは非常に面白いですね。SpecialCells と 数式の活用は発想できませんでした。試してみましたが、6000行ぐらいのテストデータでうまくいきましたよ。

テスト環境: WindowsXP P4(2.4GHz）512M Excel2002

ご質問主様の環境ではエラーがでるみたいですが、データ量が多すぎたり、PC のスペックが低いのかもしれません。どうも数式の書き込みと、その参照結果を反映させるのに時間がかかり、その処理が間に合わないのかも。。

別回答として、配列を使った例を考えてみました。お試し下さい。
行数・列数ともに特にExcelで扱える範囲内であれば制限はありません。

Sub SampleMacro()

　　Dim SH　　　　As Worksheet
　　Dim rngTARGET As Range
　　Dim BUF　　　 As Variant
　　Dim r As Long
　　Dim c As Long

　　'2行目以下の使用済セル範囲の値を配列化
　　Set SH = ActiveSheet
　　Set rngTARGET = Intersect(SH.UsedRange, SH.Range("A2:IV65536"))
　　BUF = rngTARGET.Value

　　'ブランクを埋める
　　For r = 2 To UBound(BUF) '※一行目は無視なので2から
　　　　For c = 1 To UBound(BUF, 2)
　　　　　　If IsEmpty(BUF(r, c)) Then
　　　　　　　　BUF(r, c) = BUF(r - 1, c)
　　　　　　End If
　　　　Next c
　　Next r
　　'データ書き出し
　　rngTARGET.Value = BUF

　　'後始末
　　Erase BUF
　　Set rngTARGET = Nothing
　　Set SH = Nothing

End Sub

お礼

ご回答ありがとうございます。

PC環境：WindowsXP P4(3.40GHz) Excel2003
メモリの調べ方が分からないのですが、恐らく512はあったと思います。

データ量は多いかもしれません。2000行弱、60列弱に空白以外は文字がびっしり書かれています。

教えて頂いたものをコピーし試させて頂いたのですが、やはり「rngTARGET.Value = BUF」の部分で同じ様なエラーが出てしまいます。。涙

これもデータ量が多いせいなのでしょうか？？

回答No.3

myeyesonly

いやはやお恥ずかしい。
No2 さんのおっしゃるとおりですね。こういう場合、力づくでやるのはあまりよくないようです。
今、エクセルを引っ張り出してやってみたら、ますを埋めるのはうまくできたようですが、見事に無限ループになっちゃいました。（爆）
書き加えたのは一行だけですが、修正版を書いておきます。

sub 修正版()

'開始位置はA2だけどループの都合上A1から開始。
Range("a1").Select

'終了検出用変数 n$ を空っぽじゃなくしておく
'始めの一個目で終わりに飛ばない為。

n$ = "はじめ"

While n$ > ""
Application.StatusBar = n$
'y はこれから作業する行
'注意!選択されてるセルは一つ上

y = ActiveCell.Row + 1

If Cells(y, 1) = "" Then
'空白なので前のデータが入る
Cells(y, 1) = y1
Else
'空白じゃないので保持用変数y1 を新しくする
y1 = Cells(y, 1)
End If

If Cells(y, 2) = "" Then
'空白なので前のデータが入る
Cells(y, 2) = y2
Else
'空白じゃないので保持用変数y2 を新しくする
y2 = Cells(y, 2)
End If

If Cells(y, 3) = "" Then
'空白なので前のデータが入る
Cells(y, 3) = y3
Else
'空白じゃないので保持用変数y3 を新しくする
y3 = Cells(y, 3)
End If

If Cells(y, 4) = "" Then
'空白なので前のデータが入る
Cells(y, 4) = y4
Else
'空白じゃないので保持用変数y4 を新しくする
y4 = Cells(y, 4)
End If

'この行の作業が終わったので、現在の選択されてる行(セル)を一つ下げる

Cells(y, 1).Select
y = y + 1 '←これが抜けてました。

'n$ はループ終了検出用
n$ = Cells(y, 1) & Cells(y, 2) & Cells(y, 3) & Cells(y, 4)

Wend

end sub

回答No.2

Wendy02

こんばんは。

このご質問は、そのままExcelのある仕様そのものに任せてしまえば簡単で、ヘンにロジックで考えないほうが簡単ですね。

つまり、範囲を縦の列に切り分けて、それで、SpecialCellsのブランクを取って、そのブランクのところに数式で埋めてしまえば、そのブランクは一回で済みます。ひじょうに単純です。（ただし、別な要件が加わっていたら分りません（^^;）

(範囲を縦の列に切り分け.....そのままブランクを取り出すと、縦と横がなくなってしまうから、切り分けないとできない。）

Sub BlankCellsEntering()
'No.1964591 の変形版
　 Dim r As Range
　 Dim rb As Range
　 Dim cl As Range
　 Dim a As Range

　 Application.ScreenUpdating = False

　 '最初の基点場所
　 Set r = Range("A1").CurrentRegion

　 Application.ScreenUpdating = False
　 '縦切りで取る
　 For Each cl In r.Columns

　　　On Error Resume Next
　　　Set rb = cl.SpecialCells(xlCellTypeBlanks)
　　　On Error GoTo 0
　　　If Not rb Is Nothing Then
　　　 For Each a In rb.Areas　'Areas で取る
　　　　　 If a.Row > r.Cells(2, 1).Row Then　'2行目を避ける
　　　　　　　 a.FormulaLocal = "=R[-1]C"
　　　　　End If
　　　　　　a.Value = a.Value
　　　　Next a
　　　 End If
　　Next cl
　Application.ScreenUpdating = True
　Set rb = Nothing:　 Set r = Nothing
End Sub

お礼

ご回答本当にありがとうございます。私には中身がサッパリなので教えて頂いたものをそのまま貼り付けてやってみました。30行程度ですとバッチリうまく行ったのですが、2000行位で試した所30秒ほど砂時計マークが出たと思ったら、「a.Value = a.Value」の所で「実行時エラー1004、アプリケーション定義またはオブジェクト定義のエラーです。」と出てしまいます。何故だかおわかりになりますか？

申し訳ございません、宜しくお願い致します。。涙

回答No.1

myeyesonly

こんにちは。
横方向に全項目空欄というレコードはないという前提でいいでしょうか?
いちおう、こんなの考えてみました。
データはバックアップしてからやってくださいね。(笑)
あと、解答欄のサイズの関係で、変な所に改行が入っちゃう場合がるので注意してください。

sub うまくいく保証はありません()

'開始位置はA2だけどループの都合上A1から開始。
range("a1").select

'終了検出用変数 n$ を空っぽじゃなくしておく
'始めの一個目で終わりに飛ばない為。

n$="はじめ"

while n$<>""

'y はこれから作業する行
'注意!選択されてるセルは一つ上

y = activecell.row + 1

if cells(y,1) = "" then
'空白なので前のデータが入る
cells(y,1) = y1
else
'空白じゃないので保持用変数y1 を新しくする
y1 = cells(y,1)
end if

if cells(y,2)="" then
'空白なので前のデータが入る
cells(y,2) = y2
else
'空白じゃないので保持用変数y2 を新しくする
y2 = cells(y,2)
end if

if cells(y,3) = "" then
'空白なので前のデータが入る
cells(y,3) = y3
else
'空白じゃないので保持用変数y3 を新しくする
y3 = cells(y,3)
end if

if cells(y,4) = "" then
'空白なので前のデータが入る
cells(y,4) = y4
else
'空白じゃないので保持用変数y4 を新しくする
y4 = cells(y,4)
end if

'この行の作業が終わったので、現在の選択されてる行(セル)を一つ下げる

cells(y,1).select

'n$ はループ終了検出用
n$=cells(y,1) & cells(y,2) & cells(y,3) & cells(y,4)

wend

end sub

お礼

投稿時は表がうまく見えてたのですが、こう見るとズレてて分かり難いですね。。こんなわかりにくい質問にお返事下さいまして、本当にありがとうございます。

調べましたら、項目によっては1列まるまる空白のものもありました。

そして修正版を貼り付けて試させて頂いたのですが、A列の一番最初の空白しかコピーされず、残りは全て空白のままでした。。私のやり方が悪いのでしょうか？？申し訳ございませんが、もう少しご教授願えますでしょうか？

宜しくお願い致します。