Makro oder Filter?

Hallo Ihr,
ich habe mal wieder ein Problem.
Ich habe ein *.txt File mit folgendem inhalt dies in Excel richtig dargestellt wird (Spalten/Zeilen):
Neue Datei... 17. Jan 12.006 14:51 54
Adresse 1:
17 17.11.06 14:53:52 0.175 Feb 89 22:21:11
Adresse 2:
17 17.11.06 14:53:25 0.191 Mai 23 22:21:24
Adresse 1:
18 17.11.06 14:54:00 0.172 Feb 89 22:21:19
Adresse 2:
18 17.11.06 14:53:33 0.190 Mai 23 22:21:33
Adresse 1:
19 17.11.06 14:54:08 0.174 Feb 89 22:21:27
Adresse 2:
19 17.11.06 14:53:41 0.191 Mai 23 22:21:41

Jetzt würde ich gern die Daten unter Adresse 1 und Adresse 2 sortieren damit ich ein Diagramm mit den jeweiligen Messwerten erstellen kann.
Das Textfile hat nicht immer gleich viele Messwerte (hier Ausschnitt 17-19) und es kann schon 80000 Messwerte beinhalten aber es können auch 40678 oder ähnlich viele sein dies kann man nicht beeinflussen.
Wer kann mir helfen? Mit Makro oder über Filter keine Ahnung wie es gehen könnte....
Vielen Dank für eure Tips!
Gruss
Andreas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub test() Dim Lrow As Long, i As Long, LrowA As Long Lrow = Cells(Rows.Count, 1).End(xlUp).Row Cells(Lrow + 1, 1) = "Adresse2" 'Überschrift For i = Lrow To 2 Step -1 'von letzter bis 2. Zeile: Wichtig "Adresse 1" in Zelle A1 If Cells(i, 1) = "" Then Rows(i).Delete 'wenn leer dann löschen If Cells(i, 1) = "Adresse 2" Then 'wenn Adresse 2 dann LrowA = Cells(Rows.Count, 1).End(xlUp).Row 'letzte genutze Zelle in A Rows(i + 1).Copy Cells(LrowA + 1, 1) 'darunterliegende Zeile kopieren Rows(i & ":" & i + 1).Delete 'und Fundzeilen löschen ElseIf Cells(i, 1) = "Adresse 1" Then Rows(i).Delete 'Adresse 1" Zeilen löschen End If Next i End Sub

Hi,
auf die Schnelle ;-)
Der Code gehört ins Standardmodul (Modul1) der Mappe


Sub test()
Dim Lrow As Long, i As Long, LrowA As Long
On Error GoTo ende
Application.ScreenUpdating = False
Lrow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Sheets(2).Cells(1, 1) = "Adresse 2"  'Überschrift in Blatt 2
For i = Lrow To 2 Step -1 'von letzter bis 2. Zeile: Wichtig "Adresse 1" in Zelle A1
If Sheets(1).Cells(i, 1) = "" Then Sheets(1).Rows(i).Delete 'wenn leer dann löschen
If Sheets(1).Cells(i, 1) = "Adresse 2" Then 'wenn Adresse 2 dann
LrowA = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row 'letzte genutze Zelle in A
Sheets(1).Rows(i + 1).Copy Sheets(2).Cells(LrowA + 1, 1) 'darunterliegende Zeile kopieren
Sheets(1).Rows(i & ":" & i + 1).Delete 'und Fundzeilen löschen
ElseIf Sheets(1).Cells(i, 1) = "Adresse 1" Then Sheets(1).Rows(i).Delete 'Adresse 1" Zeilen löschen
End If
Next i
ende:
Application.ScreenUpdating = True
If Err.Number > 0 Then MsgBox "Es ist ein Fehler aufgetreten"
End Sub

Gruss Harald

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread