Tentativa de agregar informações de várias linhas em uma única linha

Tentativa de agregar informações de várias linhas em uma única linha

Sou totalmente novato quando se trata de escrever macros/VB para Excel e estou ficando realmente preso nesse problema.

Aqui está uma amostra do que eu tenho

1

E aqui está o que eu espero

2

Como você pode ver, espero agregar as pontuações individuais e seus comentários para cada um reviewer_id, para cada um appl_id, ao mesmo tempo em que extraio a pontuação AGGREGATE para cada um appl_id. Às vezes não há comentários para as pontuações, o que parece complicar. Esta tabela tem cerca de 2 mil linhas, portanto, fazer isso manualmente não parecia uma opção.

Responder1

Esta macro processará os dados conforme seu exemplo. Se você tiver mais de 3 revisores por appl_id, será necessário alterar mr. Você também pode alterar a planilha e o intervalo aos quais REF se refere.

Sub marine()

Dim REF As Range
Dim REF2 As Range
Set REF = Sheets("Sheet1").Range("A1") 'location of start of data table set. Set this to the correct reference.

Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Processed"

Set REF2 = Sheets("Processed").Range("A1")

' max number of reviewers
mr = 3

' set headers
REF2.Value = "appl_id"
For i = 1 To mr
 REF2.Offset(0, (i - 1) * 2 + 1).Value = "score_" & i
 REF2.Offset(0, (i - 1) * 2 + 2).Value = "comment_" & i
Next i
REF2.Offset(0, mr * 2 + 1).Value = "aggregate_score"

i = 1
a = 0
s = 0
Do While (REF.Offset(i, 0).Value <> "")
 appl_id = REF.Offset(i, 0).Value
 If (appl_id <> REF.Offset(i - 1, 0).Value) Then 'new apple_id
   a = a + 1
   s = 0
   REF2.Offset(a, 0).Value = appl_id 'set new apple_id row
 End If
 If (REF.Offset(i, 1).Value = "AGGREGATE") Then
   REF2.Offset(a, mr * 2 + 1).Value = REF.Offset(i, 2).Value 'set aggregate
 Else
   REF2.Offset(a, s + 1).Value = REF.Offset(i, 2).Value 'set score
   REF2.Offset(a, s + 2).Value = REF.Offset(i, 3).Value 'set comment
   s = s + 2
 End If

 i = i + 1
Loop

End Sub

informação relacionada