Как продолжить значение вновь созданной переменной, пока не будет найдено новое значение?

В настоящее время я использую Excel 2003 и у меня есть вопрос, но я не могу сформулировать, не просто показывая фотографии. К сожалению, я не могу этого сделать, пока у меня не будет 10 репутаций (?). Я опишу это как могу.

У меня есть электронная таблица с заголовками в столбце А, а затем под ней (начиная также с столбца А) находятся записи, которые попадают под этот заголовок. Я попытался воссоздать его ниже, но, пожалуйста, обратите внимание: в реальной электронной таблице между строками нет пустых строк. Записи состоят из 3 столбцов (в этом случае 3-й столбец составлен, поскольку настоящая электронная таблица содержит конфиденциальную информацию).

**Fire**
05/07/2014      RP140028540   asdsfsfafk  
05/07/2014      RP140028541   asdsfsfafk    
05/07/2014      RP140028545   asdsfsfafk  
05/07/2014      RP140028548   asdsfsfafk    

**EMS**
05/07/2014      RP140028345   asdsfsfafk  
05/07/2014      RP140028549   asdsfsfafk    
05/07/2014      RP140028678   asdsfsfafk  

**Haz-Mat**
05/07/2014      RP140028111   asdsfsfafk  
05/07/2014      RP140028222   asdsfsfafk    
05/07/2014      RP140028333   asdsfsfafk  
05/07/2014      RP140028888   asdsfsfafk    
05/07/2014      RP140028284   asdsfsfafk  

Я хотел бы создать код, который будет принимать значения первого столбца (когда они выделены жирным шрифтом и, следовательно, заголовок) и затем создавать значения вновь созданной переменной в столбце D. Значения будут продолжаться до тех пор, пока не будет достигнут новый заголовок, а затем Процесс начинается снова. Так это выглядит так:

**Fire** 
05/07/2014      RP140028540   asdsfsfafk  Fire  
05/07/2014      RP140028541   asdsfsfafk  Fire    
05/07/2014      RP140028545   asdsfsfafk  Fire  
05/07/2014      RP140028548   asdsfsfafk  Fire  

**EMS**
05/07/2014      RP140028345   asdsfsfafk  EMS  
05/07/2014      RP140028549   asdsfsfafk  EMS    
05/07/2014      RP140028678   asdsfsfafk  EMS  

**Haz-Mat**
05/07/2014      RP140028111   asdsfsfafk  Haz-Mat  
05/07/2014      RP140028222   asdsfsfafk  Haz-Mat    
05/07/2014      RP140028333   asdsfsfafk  Haz-Mat  
05/07/2014      RP140028888   asdsfsfafk  Haz-Mat    
05/07/2014      RP140028284   asdsfsfafk  Haz-Mat 

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

Причина, по которой я хотел бы сделать это, двояка. Во-первых, я буду создавать отчет, который включает в себя только выбранные группы, и для меня это самый простой способ сделать это (поскольку написание кода, который хранит или удаляет определенные строки, - это мой единственный опыт работы с VB). Но что еще более важно, в конечном итоге эта информация будет использоваться в ГИС и стратифицирована по этим значениям. Поэтому мне понадобится этот столбец для будущего использования набора данных.

        Dim rowToTest As Long
For rowToTest = Cells(Rows.Count, 1).End(xlToRight).Row To 1 Step 1
With Cells(rowToTest, 1)
    If .Value <> "" And Cells(rowToTest, 3).Value = "" Then Cells(rowToTest, 5).Value = Cells(rowToTest, 1)
End With
Next rowToTest

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

1 ответ

Решение

Вот возможное решение на основе формул:

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

Заполнив формулу, вы можете скопировать / вставить значения.

В VBA:

Sub Tester()

Dim rowToTest As Long, header As String, sht As Worksheet
Dim lastRow As Long, rw As Range

Set sht = ActiveSheet
lastRow = sht.Cells(Rows.Count, 1).End(xlUp).Row
header = ""

For rowToTest = 1 To lastRow

    Set rw = sht.Rows(rowToTest)

    If Len(rw.Cells(1).Value) > 0 And Len(rw.Cells(2).Value) = 0 Then
        header = rw.Cells(1).Value
    ElseIf Application.CountA(rw.Cells(1).Resize(1, 3)) = 3 Then
        rw.Cells(4).Value = header
    Else
        'do nothing
    End If

Next rowToTest

End Sub
Другие вопросы по тегам