在两个填充的细胞之间填充空细胞

时间:2017-01-10 13:56:44

标签: excel vba excel-vba cells

情况:
在单元格“A1”上,我有值“1”
在单元格“A10”上,我的值为“2” 在单元格“A20”上,我有值“3”
在单元格“A30”上,我有值“4”

我想用Excel VBA做什么:
A1和A10之间有空单元格。我想A2:A9充满了A10的值,意思是“2” A10和A20之间有空单元格。我希望A11:19充满A20的值,即“3”。

问题是,A1到A30的范围不固定。我想在整行搜索非空的单元格,并用填充的上部单元格填充它们之间的单元格。

编辑:
为了解释更多,我有一个Access数据库,其中包含一个用日期填充的表和一个用数字填充的表。

我想向Excel表格做报告。

Dim Daten As Variant
Daten = Array(rs!DatumJMinus8Monate, rs!DatumJ, rs!DatumI, rs!DatumH, rs!DatumG, rs!DatumF, rs!DatumE, rs!DatumD, rs!DatumC, rs!DatumB, rs!DatumA, rs!DatumA4Monate)
Dim Bedarfe As Variant
Bedarfe = Array(rs!BedarfJ8Monate, rs!BedarfJ, rs!BedarfI, rs!BedarfH, rs!BedarfG, rs!BedarfF, rs!Bedarfe, rs!BedarfD, rs!BedarfC, rs!BedarfB, rs!BedarfA, rs!BedarfA, "")

Dim neuereintrag As Boolean
bedarfindex = 0
For Each element In Daten
    i = 7
    For jahre = 1 To 10
        If Cells(1, i + 1) = Year(element) Then
            For monate = 1 To 12
                If Cells(2, i + monate) = Month(element) Then
                    Cells(zeile, i + monate) = Bedarfe(bedarfindex)
                    Cells(zeile, i + monate).Font.Bold = True
                    bedarfindex = bedarfindex + 1
                    neuereintrag = True
                ElseIf IsEmpty(Cells(zeile, i + monate)) Or neuereintrag = True Then
                    Cells(zeile, i + monate) = Bedarfe(bedarfindex)
                    neuereintrag = False
                End If
            Next monate
        End If
        i = i + 12
    Next jahre
Next element

在图片中,必须删除红色圆圈中的数字。

Excel-Report-Sheet Screenshot

2 个答案:

答案 0 :(得分:0)

从下往上工作:

Sub FillUp()
    Dim N As Long
    Dim i As Long
    N = Cells(Rows.Count, "A").End(xlUp).Row
    For i = N - 1 To 1 Step -1
        If Cells(i, 1).Value = "" Then Cells(i, 1).Value = Cells(i + 1, 1).Value
    Next i
End Sub

答案 1 :(得分:0)

也许是这样的。它需要一些工作,因为如果两个值彼此相邻,或者第1列不包含值,它将失败。

Sub AutoFill()

    Dim rCell1 As Range, rCell2 As Range

    With ThisWorkbook.Worksheets("Sheet1")
        'Find the last column containing data, set both references to this
        'so the Do While doesn't fall over on the first loop.
        Set rCell2 = .Cells(1, .Columns.Count).End(xlToLeft) '1 is the row number it's looking at.
        Set rCell1 = rCell2

        'Find next cell to the left containing data and fill between these two columns.
        Do While rCell1.Column <> 1
            Set rCell1 = rCell2.End(xlToLeft)
            .Range(rCell1, rCell2.Offset(, -1)).FillRight
            Set rCell2 = rCell1
        Loop
    End With

End Sub