Option Explicit
 
Private Sub Command1_Click()
On Error Resume Next
    Dim pos As Long
    Dim i As Long
    Dim s1 As String
    Dim s2 As String
    Dim s3 As String
    Dim s4 As String
    Dim p1 As String
    Dim p2 As String
    Dim Textzeile
 
   'Einlesen und Schreiben der 1. vier Zeilen
    Open App.Path + "\Datei.txt" For Input As #1
 
    Input #1, s1
    Input #1, s2
    Input #1, s3
    Input #1, s4
    Close 1
 
    Open App.Path + "\Zieldatei.txt" For Output As #2
    Print #2, s1
    Print #2, s2
    Print #2, s3
    Print #2, s4
    Close 2
 
    'Einlesen darauffolgenden Zeilen
      Open App.Path + "\Datei.txt" For Input As #1
        Line Input #1, Textzeile
        Line Input #1, Textzeile
        Line Input #1, Textzeile
        Line Input #1, Textzeile
 
        Do While Not EOF(1)
 
        Input #1, s1
        Input #1, s2
        Input #1, s3
        pos = InStr(1, s1, Space(1))
        s1 = Mid(s1, pos + 1)
        pos = InStr(1, s2, Space(1))
        s2 = Mid(s2, pos + 1)
        flx.Rows = i + 1
        flx.TextMatrix(i, 0) = s1
        flx.TextMatrix(i, 1) = s2
        i = i + 1
    Loop
    Close 1
 
    'sortieren im FlexGrid
    flx.Col = 0
    flx.Row = 0
    flx.ColSel = 0
    flx.RowSel = flx.Rows - 1
    flx.Sort = flexSortStringAscending
 
    'Schreiben der restlichen Zeilen
    Open App.Path + "\Zieldatei.txt" For Append As #2
    For i = 0 To flx.Rows - 1
 
    'Prüft ob Zeile doppelt vorkommt
    If flx.TextMatrix(i, 0) = p1 Then
        If flx.TextMatrix(i, 1) = p2 Then
        End If
      Else
        Print #2, flx.TextMatrix(i, 0)
        p1 = flx.TextMatrix(i, 0)
        Print #2, flx.TextMatrix(i, 1)
        p2 = flx.TextMatrix(i, 1)
        Print #2, ""
    End If
 
    Next i
    Close 2
    Unload Form1
    MsgBox "Fertig"
End Sub
 
Private Sub Form_Load()
    flx.FixedCols = 0
    flx.FixedRows = 0
    flx.Cols = 3
    flx.Rows = 0
End Sub