Combine vários valores em linhas com espaços em branco

Question

Então eu pesquisei isso por um tempo, mas parece que estou batendo em uma parede. Eu vou admitir, eu fiz isso com sucesso uma vez, fiz um tutorial para meus colegas de trabalho, então eu nem ninguém foi capaz de replicar os resultados. Eu sou levemente competente com o Excel - mas VBA e codificação em geral eu ainda sou bastante novo (então minhas desculpas se eu estou perdendo algo óbvio).

Eu usei o código VBA desta questão, Como combinar valores de várias linhas em uma única linha no Excel?

Sub CombineRowsRevisited()

Dim c As Range
Dim i As Integer

For Each c In Range("A2", Cells(Cells.SpecialCells(xlCellTypeLastCell).Row, 1))
If c = c.Offset(1) And c.Offset(,4) = c.Offset(1,4) Then
        c.Offset(,3) = c.Offset(1,3)
        c.Offset(1).EntireRow.Delete
End If

Next

End Sub

Isso funcionou com sucesso uma vez. Eu tentei de novo, uma hora depois e quando eu corro o mesmo código, nada acontece. Eu pressiono o botão de corrida e tudo parece igual.

Eu fiquei desesperado e tentei o outro código na questão anteriormente referenciada, mas não funcionaria com a maneira como meus dados são configurados / o autor original preferia a fórmula inicial de qualquer maneira.

Abaixo está um exemplo dos dados com os quais estou trabalhando. Alguém tem alguma sugestão ou identifica algum erro óbvio da minha parte?

Além disso, não estou preocupado com a substituição dos dados na ID NON COURSE.

    

Answer 1

Eu usaria o suplemento de consulta de energia para atender a esse requisito. Uma consulta pode iniciar a partir de uma tabela existente do Excel. Eu usaria o comando Group By para definir a lógica de "combinação" de que você precisa.

link

Eu entregaria o resultado para uma tabela do Excel.

    

Answer 2

Eu acredito que isso vai fazer o que você está procurando. É quase o mesmo que o original, mas acrescentei alguns detalhes para torná-lo mais compreensível e fácil de modificar.

Sub CombineRowsRevisited()

    Dim c As Range
    Dim i As Integer
    Dim PersonID, REAScore, WRTScore, startDate, courseID as integer

    'Columns as I understand them (subtracting one from the actual column in the sheet)
    PersonID = 0    'personid is in column 1  etc..
    '...
    startDate = 1
    courseID = 2
    REAScore = 3    
    WRTScore = 4
    ESSScore = 5


    'Looping through each record
    For Each c In Range("A2", Cells(Cells.SpecialCells(xlCellTypeLastCell).Row, 1))

      'If personID on this record is the same as the personID on the next record
      If c.Offset(0, PersonID ) = c.Offset(1, PersonID ) Then

            'blindly overwrite startDate and courseID with the value from the next row
            c.offset(1, startDate ) = c.Offset(0, startDate)
            c.offset(1, courseID) = c.offset(0, courseID)

            'only copy the scores if they are not null
            if c.offset(0, REAScore).value <> vbNull then c.offset(1, REAScore) = c.offset(0, REAScore)
            if c.offset(0, WRTScore).value <> vbNull then c.offset(1, WRTScore) = c.offset(0, WRTScore)
            if c.offset(0, ESSScore).value <> vbNull then c.offset(1, ESSScore) = c.offset(0, ESSScore)

            'Just added this to delete the next row when a match is found
            c.entireRow.Delete
      End If
    Next

End Sub