Ситуация:
В ячейке «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
На картинке цифры в красных кружках нужно удалить.
2 ответа
По пути снизу вверх:
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
Sub FillUp() Dim N As Long Dim i As Long N = Cells(1, Columns.Count).End(xlToLeft).Column For i = N - 1 To 1 Step -1 If Cells(1, i).Value = "" Then Cells(1, i).Value = Cells(1, i + 1).Value Next i End Sub
Может что-то вроде этого. Требуется немного поработать, так как он выйдет из строя, если два значения находятся рядом друг с другом или столбец 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
code.On the Cell "A30" i have the value "4"- копируется ли это значение в строку 1048576/65536?