Versuch, Informationen aus mehreren Zeilen in einer einzigen Zeile zusammenzufassen

Versuch, Informationen aus mehreren Zeilen in einer einzigen Zeile zusammenzufassen

Ich bin ein absoluter Neuling, wenn es um das Schreiben von Makros/VB für Excel geht, und dieses Problem bringt mich wirklich nicht weiter.

Hier ist ein Beispiel von dem, was ich habe

1

Und hier ist, was ich hoffe

2

Wie Sie sehen, möchte ich die einzelnen Bewertungen und ihre Kommentare für jeden zusammenfassen reviewer_idund appl_idgleichzeitig die AGGREGIERTE Bewertung für jeden abrufen appl_id. Manchmal gibt es keine Kommentare zu den Bewertungen, was es kompliziert zu machen scheint. Diese Tabelle ist etwa 2.000 Zeilen lang, daher schien es keine Option zu sein, dies manuell zu tun.

Antwort1

Dieses Makro verarbeitet die Daten gemäß Ihrem Beispiel. Wenn Sie mehr als 3 Gutachter pro Appl_ID haben, müssen Sie ändern mr. Möglicherweise möchten Sie auch das Blatt und den Bereich ändern, auf den sich REF bezieht.

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

verwandte Informationen