如何在VBA中自動向下填充列

如何自動向下填充列；例如 Cell(A1).value=dog 和 Cell(A12).value=Pen 如何在不手動選擇列的情況下用 value=dog 和 A13 value=pen 填充 A2:A11。

 Sub filldown_example()
    Dim missingcells as range
    Dim fillsedcells as range
    
    Set missingcells = select
    For each filledcells in missingcells
    
       If filledcells = "" Then
         filledcells.filldown
       end if
    
    next filledcells
 End sub

uj5u.com熱心網友回復：

為此，您不需要 VBA。如果您在 Google 上搜索，excel fill all blanks with cell above您將獲得非 VBA 方法。

如果你仍然想要 VBA，那么試試這個。您不需要遍歷所有單元格。

代碼：

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long
    Dim rng As Range
    
    '~~> Change this to the relevant sheet
    Set ws = Sheet1
    
    With ws
        '~~> Find last row in Col A and add 1 to it
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row   1
           
        '~~> Find the blank cells
        On Error Resume Next
        Set rng = .Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks)
        On Error GoTo 0
        
        '~~> Add the formula to get values from the above cell in 1 go
        If Not rng Is Nothing Then rng.FormulaR1C1 = "=R[-1]C"
        
        '~~> Convert formulas to values
        .Range("A1:A" & lRow).Value = .Range("A1:A" & lRow).Value
    End With
End Sub

在行動：

uj5u.com熱心網友回復：

無需在這里回圈。

Sub fillit()

    With Range("a1:a13")
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
        .Value = .Value   'formula to value
    End With

End Sub

uj5u.com熱心網友回復：

填充選擇

• 這將允許您選擇具有多列的多個范圍來填充每個范圍。

范圍

Sub FillDownSelectionRange()
    
    If TypeName(Selection) <> "Range" Then Exit Sub
    
    Dim rg As Range: Set rg = Selection
    
    Dim arg As Range ' Area Range
    Dim crg As Range ' Column Range
    Dim rCell As Range ' Row Cell Range
    Dim rValue As Variant
    
    For Each arg In rg.Areas
        For Each crg In arg.Columns
            If crg.Rows.Count > 1 Then
                For Each rCell In crg.Cells
                    If Len(CStr(rCell.Value)) = 0 Then
                        rCell.Value = rValue
                    Else
                        If rCell.Value <> rValue Then
                            rValue = rCell.Value
                        End If
                    End If
                Next rCell
            End If
            rValue = Empty
        Next crg
    Next arg

End Sub

大批

• 為了加快速度，您可以回圈遍歷一個陣列，而不是遍歷單元格。

Sub FillDownSelectionArray()
    
    If TypeName(Selection) <> "Range" Then Exit Sub
    
    Dim rg As Range: Set rg = Selection
    
    Dim arg As Range ' Area Range
    Dim crg As Range ' Column Range
    Dim cData As Variant ' Column Array
    Dim rValue As Variant
    Dim r As Long
    
    For Each arg In rg.Areas
        For Each crg In arg.Columns
            If crg.Rows.Count > 1 Then
                cData = crg.Value
                For r = 1 To UBound(cData, 1)
                    If IsEmpty(cData(r, 1)) Then
                        cData(r, 1) = rValue
                    Else
                        If cData(r, 1) <> rValue Then
                            rValue = cData(r, 1)
                        End If
                    End If
                Next r
                crg.Value = cData
            End If
            rValue = Empty
        Next crg
    Next arg

End Sub

標籤：擅长 vba

上一篇：將Excel十進制日期時間轉換為time.Time

下一篇：不放置零