Заполнить в VBA значением снизу

#excel #vba

#excel #vba

Вопрос:

У меня есть приведенный ниже код для заполнения всех пустых ячеек в выделении значением сверху. Я пытаюсь сделать наоборот, заполнить на основе приведенного ниже значения. Я думаю, что мне нужно сделать цикл снизу выделения, но не знаю, как это сделать. Смотрите ниже результат, к которому я стремлюсь.

  1   1
     2
 2   2
     3
     3
 3   3
  
 Sub FillDown()

Dim columnValues  As Range, i As Long

Set columnValues = Selection

For i = 1 To columnValues.Rows.Count
    If columnValues.Cells(i, 1).Value = "" Then
        columnValues.Cells(i, 1).Value = columnValues.Cells(i - 1, 1).Value
    End If
Next

End Sub
  

Комментарии:

1. выполните итерацию снизу вверх: For i = columnValues.Rows.Count to 1 Step -1 и измените columnValues.Cells(i - 1, 1).Value на columnValues.Cells(i 1, 1).Value

Ответ №1:

Выполнить итерацию снизу вверх: For i = columnValues.Rows.Count to 1 Step -1

И измените columnValues.Cells(i - 1, 1).Value на columnValues.Cells(i 1, 1).Value

 Sub FillDown()

    Dim columnValues As Range
    Set columnValues = Selection
    
    Dim i As Long
    For i = columnValues.Rows.Count To 1 Step -1
        If columnValues.Cells(i, 1).Value = "" Then
            columnValues.Cells(i, 1).Value = columnValues.Cells(i   1, 1).Value
        End If
    Next

End Sub
  

Перед:

введите описание изображения здесь

После:

введите описание изображения здесь

Комментарии:

1. Я вижу, где я скопировал неправильно. Это сработало, спасибо!

Ответ №2:

Я бы сделал это немного по-другому и заполнял диапазоны за раз, а не ячейки за раз:

 Sub FillUp()
Dim CurrRow As Long, FillRow As Long, LastRow As Long
CurrRow = 1
LastRow = Range("A" amp; Rows.Count).End(xlUp).Row
Do Until CurrRow >= LastRow
    If Not IsEmpty(Range("A" amp; CurrRow   1)) Then
        CurrRow = CurrRow   1
    Else
        FillRow = Range("A" amp; CurrRow).End(xlDown).Row - 1
        Range("A" amp; CurrRow amp; ":A" amp; FillRow).Value = Range("A" amp; CurrRow).Value
        CurrRow = FillRow   1
    End If
Loop
End Sub
  

Использование свойства .end ссылки на ячейку позволит вам сделать это, что означает, что вы проводите меньше времени на листе, это значительно повысит производительность при наличии больших объемов данных или при наличии большого количества вычислений на листе

Комментарии:

1. Если вы собираетесь попытаться оптимизировать, почему бы просто не выполнить их все сразу? Смотрите мой ответ для всех обновлений, выполненных сразу.

2. По-прежнему по одной точке за раз только в массиве, в отличие от листа, вероятно, быстрее, чем мой метод, поскольку выполняется в памяти, а не на листе, и публикуется только один раз, хороший :). Для начала я предлагаю вам прочитать и понять, как работают все три этих решения, потому что все они имеют действительные преимущества и могут быть полезны вам в будущем.

3. Спасибо вам обоим! Ценю помощь и информацию.

Ответ №3:

Я знаю, что Скотт Крейнер уже знает об этом, но поскольку был опубликован ответ, содержащий ссылку на оптимизацию производительности, я почти уверен, что это лучший подход.

 Dim myArray(), i As Long

myArray = columnValues

    For i = UBound(myArray) - 1 To LBound(myArray, 1) Step -1
        
        If myArray(i, 1) = "" Then
            myArray(i, 1) = myArray(i   1, 1)
        End If
    Next i
columnValues = myArray