將單元格的值粘貼到下面所有空白單元格中，然后移至新值以在Excel VBA宏中重復該過程

Question

我正在嘗試做與在這里找到的問題類似的事情：

基本上，它試圖將滾動的第一個值粘貼到它下面的所有空白中，直到出現另一個值，該值也粘貼到它下面的所有空白中，重復此過程，直到到達具有包含該行的行的單元格為止。最后輸入數據。

我希望能夠通過為其創建宏來使其適合我的Excel工作表。 到目前為止，這是最合適的代碼：

Sub fillBlanks()
  With Worksheets("Sheet1")
    With .Range(.Cells(2, "B"), .Cells(Rows.Count, "B").End(xlUp))
      With .Offset(0, -1).SpecialCells(xlCellTypeBlanks)
        .FormulaR1C1 = "=R[-1]C"
      End With
      With .Offset(0, -1)
        .Value = .Value
      End With
    End With
  End With
End Sub

我似乎無法找到一種方法使其僅通過B列進行搜索，並且如果下面沒有空格，則忽略粘貼該值。

在此圖像中，值變為0004,0002,0004。 我想避免宏在第二個0004值中粘貼0002值。

請給我一些幫助嗎？

謝謝，

Aydan。

Answer 1

除了您的相關鏈接中列出的內容外，我還有其他建議； 您可以找到工作表的最后一行並在B列中的單元格之間循環，同時比較值。

Dim i as Integer, LR as Long

LR=Cells(Rows.Count, "B").End(xlUp).Row

For i = 2 to LR

If Cells(i,2).Value="" Then
    Cells(i-1,2).Copy Cells(i,2)
    Else
    End If

Next i

Answer 2

嘗試選擇所需的范圍，然后運行以下命令：

子RepeatTitle（）

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

    Dim RNG As Range
    Dim Str As String
    Dim J As Integer
    Dim K As Integer


    Set RNG = Selection
    K = 1
    J = 1

    For K = 1 To RNG.Columns.Count
        For J = 1 To RNG.Rows.Count
            If RNG.Cells(J, K) = "" Then
                If J = 1 Then
                    RNG.Cells(J, K) = ""
                Else
                    RNG.Cells(J, K) = RNG.Cells(J - 1, K)
                End If
            End If
        Next J
    Next K

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

這將適用於任何J * K選擇。

Answer 3

該代碼利用FIND和FILLDOWN快速查找包含值的下一行，然后填充其間的所有內容：

Public Sub FillGaps()

    Dim wrkSht As Worksheet
    Dim rFindCells As Range
    Dim rFillColumn As Range
    Dim sFirstAddress As String
    Dim rPrevious As Range

    Set wrkSht = ThisWorkbook.Worksheets("Sheet1")

    Set rFillColumn = wrkSht.Columns(2)

    With rFillColumn
        Set rFindCells = .Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not rFindCells Is Nothing Then
            sFirstAddress = rFindCells.Address
            Do
                Set rPrevious = rFindCells
                Set rFindCells = .FindNext(rFindCells)

                If rFindCells.Row <> rPrevious.Row + 1 And rFindCells.Row > rPrevious.Row Then
                    wrkSht.Range(rPrevious, rFindCells.Offset(-1)).FillDown
                End If

            Loop While rFindCells.Address <> sFirstAddress
        End If
    End With

End Sub