表内の空白セルを左セルの値コピーで埋めたい

Question

上の表を下の表のようにしたいです

||A|B|C|D|E|F|G|
|:--|:--:|--:|
|1|||||100||||
|2|30|||20|||80
|3||10||40||60|

||A|B|C|D|E|F|G|
|:--|:--:|--:|
|1|0|0|0|0|100|100|100|
|2|30|30|30|20|20|20|80
|3|0|10|10|40|40|60|60

#条件
0. 所与の値は生かす

1. a1から所与の値があるセルe1一つ前までを選択　(a1:d1)
2. a1の値をコピー
3. e1は生かす
4. f1,最終列g1までe1をコピー
5. 次の行へ

列は800程度、行は1600程度の数があるため、手動のオートフィルではなく、自動化できたらと思うのですが、所与の値を生かす論理式が思いつきません

ExcelでもGoogleスプレッドシート でもマクロでも何かしらでできたらと思います

Comments

[meg_]

・条件が抜けているかと思いますが、「コピー元が空白の時は'0'とする」ということですか？
・マクロはどのくらい出来ますか？

[dela]

はい、コピー元が空白の時は０とします
マクロは、あんまりできないです。サンプルコードを参考に修正したりとか程度です。

Answer 1

G2:SEF1600
という範囲です。大きすぎるのでしょうか。

ということは「約12,980」列ですね。
最初は「列は800程度、行は1600程度」と言ってませんでしたっけ？（汗；

こちらで、2000行分のデータを作ってやってみましたが、
とりあえず処理は完了しました。５分くらいかかりましたが・・・

デバッグすると
cur = rng.Value
でとまります

なるほど、そうでしたか。
それでは、プロシージャの冒頭部分のDim文の「Integer」をすべて「Long」に置き換えてみてください。
もしかしたら、たんに「rng.Value」の値が「Integer」を超えていただけかもしれません。
私の方はサンプルの値をタイル状にコピーしていたので気が付きませんでした。

なお、処理が長時間かかる場合には、

    For ro = yStart To yEnd
        Debug.Print ro ` 現在処理中の行番号
        For co = xStart To xEnd

のようにしておけば、現在処理中の行番号を出力してくれます。

Comments

[dela]

こちらの後出しにもかかわらずありがとうございました！大変勉強になりました。

Answer 2

Sub test()
    Dim a As Range
    
    With ActiveSheet.UsedRange
        .Columns(1).SpecialCells(xlCellTypeBlanks).Value = 0
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]"
        .Value = .Value
    End With
End Sub

こんな感じですかね。
量が多くて処理できないなら、
セル範囲を狭めて何回か繰り返してください。

Answer 3

大変失礼しました。
オーバーフローですか、、、Range()で取得する範囲が大きすぎるのでしょうか？

ちょっと直してみました。
セルの取得には「Sheet1.Cells(ro, co)」を使っています。
これでどうでしょうか？

Sub fill_test2()
    Dim rng As Range
    Dim cur As Integer
    Dim ro As Integer, co As Integer
    Dim xStart As Integer, xEnd As Integer
    Dim yStart As Integer, yEnd As Integer
    Dim init_val As Boolean
    
    ' 指定された範囲の座標を取得する
    With Sheet1.Range("A1:G4")
        xStart = .Column
        xEnd = xStart + .Columns.Count - 1
        yStart = .Row
        yEnd = yStart + .Rows.Count - 1
    End With
        
    For ro = yStart To yEnd
        For co = xStart To xEnd
            ' 行が変わったらフラグをクリアする
            If co = xStart Then init_val = False
            
            Set rng = Sheet1.Cells(ro, co)
            
            If rng.Value = "" Then
                If init_val Then
                    rng.Value = cur
                Else
                    rng.Value = 0
                End If
            Else
                cur = rng.Value
                If init_val = False Then init_val = True
            End If
        Next co
    Next ro
End Sub

もし、これでもオーバーフローする場合には、
最初のWith文はカットして、
xStart, xEnd, yStart, yEndを手動でセットしてみてください。
それで動くかどうか・・・

Comments

[dela]

ありがとうございます これでもオーバフローしてしまいました
デバッグすると
cur = rng.Value
でとまります

G2:SEF1600
という範囲です。大きすぎるのでしょうか。。

Answer 4

以下のようなコードで実現できると思います。

Sub fill_test()
    Dim rng As Range
    Dim cur As Integer
    Dim prev As Integer: prev = -1
    Dim init_cur As Boolean
    
    For Each rng In Sheet1.Range("A1:G4")
        If rng.Column < prev Then init_cur = False
        prev = rng.Column
        
        If rng.Value = "" Then
            If init_cur Then
                rng.Value = cur
            Else
                rng.Value = 0
            End If
        Else
            cur = rng.Value
            If init_cur = False Then init_cur = True
        End If
    Next rng
End Sub

↓ 上記のコードで以下のようになります。

Comments

[dela]

ありがとうございます
こちらのコードで試してみたところ、狭い範囲でなら動くのですが、
表全体　1600行×800列だと、「実行時エター'6'　オーバーフローしました」という警告が出てしまいます。たまに１行目はうまくいっているのですが、２行目以降の処理ができないようです。

繰り返し回数が大きすぎるのは別の作法が必要になるでしょうか。

[autumn_nsn]

失礼しました。
コードを手直ししてみましたので、そちらを試してみてください。
この欄ではソースを記述できないので、別の回答として書き込んでいます。