将循环添加到excel的vba代码中

Question

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

我在下面有下面的代码，它“用上面的值填充列中的空白单元格”并且工作正常。

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

我已经tryed到puzzel这一点还没有得到任何地方

感谢

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")