Excel 2010 - Daten blockweise umschichten

[andrea_office]

Hallo,

ich habe ein dringendes Problem, da es viele Leute betrifft, die die Daten brauchen.
Ich habe Excel-Tabellen (bis ca. tausend Datenzeilen) in der Struktur:

Fallnr......Merkmal
1234........FE00012
............FE00014
5234........FE00018
............FE00012
7234........FE00024
............FE00012
............FE00035
9234........FE00001
1134........FE00015
............FE00009
7714........FE00013

Die Fallnummern und die FE0001 Werte sind schon sauber in Excel-Zellen getrennt
Ich muß die Daten so umschichten, daß es pro Fallnummer nur noch eine Datenzeile gibt.
Also so:
Fallnr.....Merkmal1......Merkmal2
1234.......FE00012.......FE00014

Die Problematik liegt darin, daß es mal 1, mal 2, mal 3 oder 4 Merkmale pro Fall gibt.

[Officer]

Hallo andrea,

ich habe mal ein VBA-Beispiel gebaut, das den Code entsprechend umschichtet.
Natürlich müsstest Du den Code noch an deine Tabelle anpassen.

Der Code sieht wie folgt aus:

Code: Visual Basic

1.  
2. Sub umgliedern()
3.  
4. Dim lngZeile As Long
5. Dim lngSpalte As Long
6.  
7. '** Vorgaben definieren
8. Set ws = ThisWorkbook.ActiveSheet
9. lngZeile = 1
10. lngSpalte = 7
11.  
12. '** Ausgabebereich löschen
13. ws.Range("E2:Z100").ClearContents
14.  
15.  
16. '** Durchlaufen des Datenbestands
17. For a = 2 To ws.Cells(Rows.Count, 2).End(xlUp).Row
18.  
19.   '** Prüfen, ob die Zeile in Spalte 1 einen Wert enthält
20.  If ws.Cells(a, 1).Value <> "" Then
21.    
22.     lngZeile = lngZeile + 1 'Zeilennummer erhöhen
23.    ws.Cells(lngZeile, 5).Value = ws.Cells(a, 1).Value 'Wert aus Spalte 1 in neuen Bereich übertragen
24.    ws.Cells(lngZeile, 6).Value = ws.Cells(a, 2).Value 'Wert aus Spalte 2 in neuen Bereich übertragen
25.    lngSpalte = 7 'Spaltennummer setzen
26.  
27.   '** Prüfen, ob Zeile in Spalte 1 leer ist
28.  ElseIf ws.Cells(a, 1).Value = "" Then
29.    
30.     ws.Cells(lngZeile, lngSpalte).Value = ws.Cells(a, 2).Value 'Wert aus Spalte 2 in neuen Bereich übertragen
31.    lngSpalte = lngSpalte + 1 'Spaltennummer erhöhen
32.  End If
33.  
34. Next a
35. End Sub
36.  
37.  

Den VBA-Code findest Du auch in der beigefügten Beispieldatei.

Gruß

Officer