Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1320to1324
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Tabellenblatt strukturieren

Tabellenblatt strukturieren
28.06.2013 08:37:12
stefan
Hallo an alle Excel Profis,
wie kann ich eine unstrukturierten Tabelle (hier werden jeden Tag zig Files
eingeladen)
in eine strukturierte Tabelle ändern.
Hab mal ein Beispiel hochgeladen, welches im ersten Tabellenblatt
die aktuelle Struktur zeigt, und im Tabellenblatt Ergebnis, so wie ich es bräuchte.
https://www.herber.de/bbs/user/86099.xls
Wäre echt super, wenn von euch jemand ne Idee hätte, wie man das ändern kann.

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
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.

Anzeige
Korrektur:
28.06.2013 09:27:53
Klaus
Hallo Stefan,
direkt nach absenden bin ich darüber gestolpert, dass deine Linien warscheinlich nicht "Linie1, Linie2" usw heissen wie im Muster. Darauf basierte aber meine Logik!
Mit folgender Codekorrektur können die Maschinen auch "Müller-Weingarten", "HalloWelt" oder "Katze3" heissen:
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 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 = VBA.Trim(r.Value)
'Wenn "Linie*" in der Zelle steht, ist der Linienname getroffen
If sLinie = "Linie" 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 = r.Offset(3, 0).Value
End With
End If
Next r
End With
End Sub
Grüße,
Klaus M.vdT.

Anzeige
AW: Korrektur:
28.06.2013 09:40:30
stefan
Hallo Klaus,
SUPER SUPER SUPER. Genau so brauch ich das.
DANKE dass du dir so viel Zeit für mich genommen hast !!!!
D A N K E
:-)
Stefan

Danke für die Rückmeldung! owT.
28.06.2013 09:48:36
Klaus
.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige