2

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

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

我需要在非连续列上使用它。有没有办法向它添加一个循环，以便它在 [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
4

1 回答 1

3

您可以尝试以下方法：

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")
于 2013-04-26T14:43:17.887 回答