Question

此宏用于使用上一行中的值填充空行。我需要调整它，以便所有列都被填充，而不仅仅是B列。谢谢！

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("b1").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()
    With ActiveSheet.UsedRange
        If WorksheetFunction.CountBlank(.Cells) > 0 Then
            With .SpecialCells(xlCellTypeBlanks)
                .FormulaR1C1 = "=R[-1]C"
                .Value = .Value
            End With
        End If
    End With
End Sub

Answer 2

这将循环遍历A列到J（代码中的For i = 1 to 10）。您可以根据需要进行调整。

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 emptyRng As Range
Dim i       As Long

Set wks = ActiveSheet

With wks
    For i = 1 To 10
        Set rng = .Range(.Cells(1, i), .Cells(.Cells(Rows.Count, i).End(xlUp).Row, i))
        On Error Resume Next
        Set emptyRng = rng.SpecialCells(xlCellTypeBlanks)
        On Error GoTo 0
        If emptyRng Is Nothing Then    ' If we have empty cells, do the following
            MsgBox ("No blanks found")
            'Exit Sub ' Commented this out because you want to keep looping through columns, not exit sub.
        Else
            emptyRng.FormulaR1C1 = "=R[-1]C"
            rng.EntireColumn.Value = rng.EntireColumn.Value
        End If
    Next i
End With                     'wks

End Sub

使用上面的值填充行

2 个答案: