将循环添加到Excel的VBA代码

我对vba知之甚less，所以我希望有人能帮助我。

我有下面的代码，它填写空白单元格中的值以上的值，并正常工作。

我需要在非连续的颜色上使用它。 有没有办法给它添加一个循环，以便在[BDHI]列上运行？

我已经尝试了这个困惑，没有任何地方

谢谢

Sub FillColBlanks() 'by Dave Peterson 2004-01-06 'fill blank cells in column with value above 'http://www.contextures.com/xlDataEntry02.html Dim wks As Worksheet Dim rng As Range Dim Lastrow As Long Dim col As Long Set wks = ActiveSheet With wks 'col = ActiveCell.Column 'or col = .Range("G2").Column Set rng = .UsedRange 'try to reset the lastcell Lastrow = .Cells.SpecialCells(xlCellTypeLastCell).Row Set rng = Nothing On Error Resume Next Set rng = .Range(.Cells(2, col), .Cells(Lastrow, col)) _ .Cells.SpecialCells(xlCellTypeBlanks) On Error GoTo 0 If rng Is Nothing Then MsgBox "No blanks found" Exit Sub Else rng.FormulaR1C1 = "=R[-1]C" End If 'replace formulas with values With .Cells(1, col).EntireColumn .Value = .Value End With End With End Sub 

Answer 1

你可以尝试下面的：

 Sub FillColBlanks(sColRange as string) 'by Dave Peterson 2004-01-06 'fill blank cells in column with value above 'http://www.contextures.com/xlDataEntry02.html Dim wks As Worksheet Dim rng As Range Dim Lastrow As Long Dim col As Long Set wks = ActiveSheet With wks 'col = ActiveCell.Column 'or col = .Range(sColRange).Column Set rng = .UsedRange 'try to reset the lastcell Lastrow = .Cells.SpecialCells(xlCellTypeLastCell).Row Set rng = Nothing On Error Resume Next Set rng = .Range(.Cells(2, col), .Cells(Lastrow, col)) _ .Cells.SpecialCells(xlCellTypeBlanks) On Error GoTo 0 If rng Is Nothing Then MsgBox "No blanks found" Exit Sub Else rng.FormulaR1C1 = "=R[-1]C" End If 'replace formulas with values With .Cells(1, col).EntireColumn .Value = .Value End With End With End Sub 

所以你可以这样调用这个程序：

 Call FillColBlanks("B1") Call FillColBlanks("D1") Call FillColBlanks("H1") Call FillColBlanks("I1")