Warning: file_get_contents(/data/phpspider/zhask/data//catemap/9/loops/2.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Loops 将循环添加到excel的vba代码_Loops_Excel_Vba - Fatal编程技术网

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

Loops 将循环添加到excel的vba代码,loops,excel,vba,Loops,Excel,Vba,我对vba知之甚少,所以我希望有人能帮助我 我有下面的代码,它“用上面的值填充列中的空白单元格”,工作正常 我需要在非连续列上使用它。 有没有办法向它添加一个循环,以便它在[bdhi]列上运行 我试着把这件事说出来,但没有任何进展 谢谢 Sub FillColBlanks() 'by Dave Peterson 2004-01-06 'fill blank cells in column with value above 'http://www.contextures.com/xlDataEn

我对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

您可以尝试以下方法:

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

+ 1如果你隐藏所有的列,除了B,D,H,那么你可以把它们看成一个范围吗?这会阻止您一次又一次地调用
FillColBlanks
?只是一个想法。。。