上記の値をコピーするExcel VBAマクロを自動補完するには

Question

私はExcelドキュメントを持っており、セルの値で列を完成させるためのマクロを書きたいと思います。例えば：

figure 1

私は、私はそれを見つけるまで、私はそれをクリックしたときに自動的をvalue1とその列の残りのセルを完了することを視覚的に基本的なボタンを持つようにしたい列A内をvalue1を持つ図1では

空でないセル。列b iには、値3の値4と値5が太字の黒で表示されます。私がボタンを押すと、VBコードは自動的に赤色の値でセルを完成させます。私の英語で申し訳ありません、私の母国語ではありません。要約すると、最初は黒の値しかありません。ボタンをクリックすると、自動的に赤の値が追加されます。私を助けてくれますか？私はこのコードを持っている：

Sub split() 
Dim columns As Range, i As Long 

Set columns = Selection 

i = 1 

For i = 1 To columns.Rows.Count 
    If columns.Cells(i, 1).Value = "" Then 
     columns.Cells(i, 1).Value = columns.Cells(i - 1, 1).Value 
    End If 
Next 

End Subの

それが唯一の選択した列のために仕事をしていませんが、私はそれがブック全体に適用したいです。どのように私はこれを変更できますか？

Answer 1

これはどのように機能しますか？我々は一度に空白のセルを選択するために、SpecialCells()を使用することができますように、それは、セルをループよりも少し速くする必要があります：

Sub copyDown() 
Dim lastRow As Long, firstRow As Long, lastCol As Long, i As Long 
Dim rng As Range, totalCell As Range 
Dim cols As Variant 

cols = Split(InputBox("What columns do you want? Use space to separate." & vbCrLf & vbCrLf & "I.e. 'A C D F'"), " ") 

'Set totalCell = Range("A:A").Find(what:="SubTotal :", LookIn:=xlPart) 

If Not Application.IsNA(Application.Match("SubTotal *", Range("A:A"), 0)) Then 
    Set totalCell = Cells(Application.Match("SubTotal :", Range("A:A"), 0), 1) 
End If 

For i = LBound(cols) To UBound(cols) 
    firstRow = Cells(1, cols(i)).End(xlDown).Row 

    Set rng = Range(Cells(firstRow, cols(i)), Cells(totalCell.Row - 1, cols(i))) 
    rng.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=r[-1]C" 
    rng.Value = rng.Value 
Next i 

End Sub