向下或向上复制数据单元格

Question

我是vba中的菜鸟。但是，我想实现以下用例，以使我的合作生活更轻松。 我有以下数据：

我想将第一行向下复制，直到我击中一个填充的字段，第二行也向下，直到我击中一个填充的字段，第三行向上和向下以及第四行向上。

我希望结果表看起来像这样。

有关如何在vba中实现此用例的任何建议吗？

感谢您的回复！

Answer 1

希望得到这个帮助。

它将在您当前的选择

上运行

将整个代码复制到一个模块中，运行fill_down（）填充，fill_up（）填充。

'======================
'******Filling*********
'======================
Sub fill_up()
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[1]C"
End Sub

Sub fill_down()
    Call copy_last(Selection)
    Call filling
End Sub

Function copy_last(r As range)
    Dim arr() As Variant
    Dim x As Double
    Dim arr_size As Double

    arr = r
    arr_size = UBound(arr, 1)

    For x = arr_size To 1 Step -1
        If Not isempty(arr(x, 1)) Then
            Exit For
        End If
    Next x

    r(r.Row, 1) = arr(x, 1)

End Function

Function filling()
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[-1]C"
End Function
'=======================
'******End filling******
'=======================

Answer 2

你能试试这个吗？此例程假设G列为主要起点，并检查同一行中A，B，C，D列是否为空，并相应地填充。

Sub ASD()
Dim lastRow As Long

lastRow = Range("G" & Rows.Count).End(xlUp).Row

For Each c In Range("G:G")
    If c.Value <> "" Then
        If c.Offset(0, -3).Value = "" Then
            c.Offset(0, -3).Value = c.Offset(0, -3).End(xlDown).Value
        End If
        If c.Offset(0, -4).Value = "" Then
            c.Offset(0, -4).Value = c.Offset(0, -4).End(xlUp).Value
        End If
        If c.Offset(0, -5).Value = "" Then
            c.Offset(0, -5).Value = c.Offset(0, -5).End(xlUp).Value
        End If
        If c.Offset(0, -6).Value = "" Then
            c.Offset(0, -6).Value = c.Offset(0, -6).End(xlUp).Value
        End If
    End If
Next c
End Sub

唯一的问题是，如果G列中的参考单元格为空，它就不会做任何事情。我认为你无论如何都不需要它。