AW: Tabellenblatt strukturieren
28.06.2013 09:21:30
Klaus
Hallo Stefan,
lösche in deinem Blatt "Ergebnis" alle Einträge ausser den Überschriften. Dann lasse folgendes Script laufen:
Option Explicit
Sub TEXTFILEStoERGEBNIS()
'gegebenes Format in übersichtliches Format verwandeln
'2013 by Klaus M.vdT.
Const InputSheet As String = "TEXTFILES"
Const OutputSheet As String = "ERGEBNIS"
Dim lRowInput As Long
Dim fRowOutput As Long
Dim lRowOutput As Long
Dim r As Range
Dim sLinie As String
Dim sLinie2 As String
Dim fLinieRow As Long
Dim lLinieRow As Long
fRowOutput = 2 'erste Zeile Output, in Zeile 1 Überschriften!
With Sheets(InputSheet)
lRowInput = .Cells(.Rows.Count, 2).End(xlUp).Row
For Each r In .Range(.Cells(1, 2), .Cells(lRowInput, 2))
'Alle Auftragsnummern übertragen
If IsNumeric(r.Value) And Not r.Value = "" Then
'Details kopieren
.Range(.Cells(r.Row, 2), .Cells(r.Row, 6)).Copy
'als "Wert" einfügen
Sheets(OutputSheet).Cells(fRowOutput, 1).PasteSpecial xlPasteValues
'Zeilenzähler erhöhen
fRowOutput = fRowOutput + 1
End If
'Alle Linien übertragen
sLinie = Left(VBA.Trim(r.Value), 5)
sLinie2 = VBA.Trim(r.Value)
'Wenn "Linie*" in der Zelle steht, ist der Linienname getroffen
If sLinie = "Linie" And sLinie sLinie2 Then
With Sheets(OutputSheet)
'alle bisherigen Auftragsnummern mit der getroffenenen Linie
fLinieRow = .Cells(.Rows.Count, 6).End(xlUp).Row + 1
lLinieRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Cells(fLinieRow, 6), .Cells(lLinieRow, 6)).Value = sLinie2
End With
End If
Next r
End With
End Sub
Ich habe mich mit Spalten und Zeilenvorgaben streng an dein Muster gehalten.
Grüße,
Klaus M.vdT.