Microsoft Office Forum [ www.Office-Fragen.de ] >> READONLY <<

Microsoft Office 2003-2019 => Excel => Thema gestartet von: andrea_office am Januar 17, 2013, 21:15:00 Nachmittag

Titel: Excel 2010 - Daten blockweise umschichten
Beitrag von: andrea_office am Januar 17, 2013, 21:15:00 Nachmittag
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.
Titel: Antw: Excel 2010 - Daten blockweise umschichten
Beitrag von: Officer am Januar 19, 2013, 16:17:18 Nachmittag
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