Заполнение всех пустых ячеек между двумя равными ячейками в одном столбце на листе Excel (с одинаковым значением равных ячеек)

Question

У меня есть следующий excel

Я пытаюсь следующий код

> Sub fill_blanks()
 Dim i As Long
 i = 2 '
 Do Until Range("B" & i) = ""
 Range("B" & i).Select
 If ActiveCell.FormulaR1C1 <> "" Then
    Range("A" & i).Select
      If ActiveCell.FormulaR1C1 = "" Then
           Range("A" & i - 1).Copy
           Range("A" & i).PasteSpecial Paste:=xlPasteValues
           Else
           i = i + 1
      End If
    Else
    i = i + 1
  End If
  Loop
End Sub > 

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

Таким образом, результат будет следующим:

Но используя код, я получаю что-то другое.

Это то, что я получаю с этим кодом

Answer 1

1. Найдите последнюю использованную строку LastRow, чтобы мы знали, где остановиться.
2. L oop по вашим строкам, когда вы сталкиваетесь с ячейкой epmty, запомните ее FirstEmptyRow
3. Продолжайте цикл до тех пор, пока вы снова не найдете данные, тогда строка перед будет LastEpmtyRow. Теперь мы знаем начало и конец пустого пространства.
4. Проверьте, находится ли выше пустого пространства и ниже пустого пространства одна и та же дата. Если это так, заполните его пустым пространством, в противном случае заполните x.

Таким образом, вы получите что-то вроде

Option Explicit

Public Sub FillData()
    Const START_ROW As Long = 2  'define first data row
    Const COL As String = "A"    'define the column

    Dim ws As Worksheet  'define your worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Dim LastRow As Long  'find last used row in column A
    LastRow = ws.Cells(ws.Rows.Count, COL).End(xlUp).Row

    Dim FirstEmptyRow As Long, LastEpmtyRow As Long 'first and last empty row of a empty range

    Dim iRow As Long
    For iRow = START_ROW To LastRow
        If ws.Cells(iRow, COL).Value = vbNullString And FirstEmptyRow = 0 Then
            'found first row of an empty range
            FirstEmptyRow = iRow

        ElseIf ws.Cells(iRow, COL).Value <> vbNullString And FirstEmptyRow <> 0 Then
            'found last row of an empty range
            LastEpmtyRow = iRow - 1

            'check if same date to fill either the date or x
            If ws.Cells(FirstEmptyRow - 1, COL).Value = ws.Cells(LastEpmtyRow + 1, COL).Value Then
                'fill date
                ws.Range(ws.Cells(FirstEmptyRow, COL), ws.Cells(LastEpmtyRow, COL)).Value = ws.Cells(FirstEmptyRow - 1, COL).Value
            Else
                'fill x
                ws.Range(ws.Cells(FirstEmptyRow, COL), ws.Cells(LastEpmtyRow, COL)).Value = "x"
            End If

            'reset variables
            FirstEmptyRow = 0
            LastEpmtyRow = 0
        End If
    Next iRow
End Sub

^{Изображение 1: Иллюстрация процесса.}