如何使用VBA填写系列？

Question

我正在尝试获取代码以在D列中搜索非空白单元格。当找到一个不为空的单元时，它将复制该单元格并填充下面的系列。然后，我希望它重复此代码，直到“ D3020”为止。

但是，每次我运行代码时，它都会复制一个单元格并将其一直粘贴到“ D3020”。还有其他值也需要复制，因此我需要解决此问题。我尝试使用.offset属性。我尝试使用.range.copy属性。

 Sub Fill()
 Dim SRng As Range
 Dim SCell As Range

 Set SRng = Range("D1101:D3020")

 For Each SCell In SRng
     If SCell <> "" Then
         SCell.Copy
         Range(SCell, SCell.Offset(10, 0)).PasteSpecial(xlPasteAll)
     End If
 Next SCell

 End Sub

我想要这段代码在Range（“ D1101：D3020”）中搜索<>“”的单元格。找到一个序列后，将其填充在其下方的序列中，并停在下一个单元格中包含数字的位置。

例如

D1101 = 1601166（参见图片）我想复制它并填充它下面的系列。彼此之间正好相隔十行。然后D1121 = 1601168（参见图片）我也想为此复制/填充系列。

Answer 1

无需循环；只需用上面的值填充空白即可。

sub fillBlanks()

    dim brng as range

    on error resume next
    set brng = Range("D1101:D3020").specialcells(xlcelltypeblanks)
    on error goto 0

    if not brng is nothing then
        brng.formular1c1 = "=r[-1]c"
        Range("D1101:D3020") = Range("D1101:D3020").value
    end if

end sub

Answer 2

Option Explicit

Sub Test()

    FillEmptyFromTop [D1101:D3020]

End Sub

Sub FillEmptyFromTop(oRng As Range)

    Dim v, a, i

    With oRng.Columns(1)
        a = .Value
        For i = LBound(a, 1) To UBound(a, 1)
            If IsEmpty(a(i, 1)) Then a(i, 1) = v Else v = a(i, 1)
        Next
        .Value = a
    End With

End Sub