Aus einer Textdatei (editor) von bestimmten Zeilen in Spalten verschieben

[marbec75]

Guten Abend,

Ich bin neu Hier und befasse mich gerade etwas mit Excel.
Ich habe über Studysmarter (onlinekarteikarten programm) die Möglichkeiten Fragen und antworten als Karteikarten auszugeben die vorher in eine Excel datei eingetragen wurden.

Ich habe eine .txt datei mit sehr vielen Fragen und Antworten , diese möchte ich in Excel einfügen das , dass format mit der Webseite funktioniert.

  Mappe1.xlsx (Größe: 10,55 KB / Downloads: 11)

So ist der Aufbau in der .txt Datei. Es beginnt immer mit einer ID.

ID 14704: Worin begründet sich eine mögliche Abschnittsreparatur ?
Wirtschaftlichkeit
Geringerer Eingriff in die Originalstruktur bei Karosserie.

ID 14700: Welche aussagen zur selbsttragenden Karosserie ist richtig ?
Sie kann in Schalenbauweise ausgeführt sein.
Sie kann in Gerippebauweise (Space Frame) ausgeführt sein.
Sie kann in Rohrbauweise ausgeführt sein.



Das einfügen der TEXTE in eine Excel datei funktioniert und wird auch wie in der .txt datei dargestellt.
nun müsste aber alles was in den folgenden zeilen steht bis zur nächsten ID eine Spalte nach rechts in der selben Zeile, sind es zwei antworten dann die zweite antwort weiter eine spalte in der selben zeile usw.

Ich denke das anschauen der Exceldatei wäre sehr verständlich, da es sich um sehr viele Fragen haneldet (ca. 2000 ) wäre das super wenn jemand eine lösung hätte

vg 
Markus

[Ralf A]

Hi Markus,

folgenden Code (auf Deiner Vorgabe aufbauend) in das Modul der betreffenden Tabelle:

Code:

Option Explicit

Sub Aufteilen()
Dim rng As Range, ofs As Byte, var, zeile As Long, blnID As Boolean, delAdr As String

Set rng = Range("A1:A" & Cells.SpecialCells(xlLastCell).Row)
    If Not rng Is Nothing Then
        For Each var In rng
        If var <> "" Then
            If Left(var, 3) = "ID " Then
                ofs = 1: zeile = var.Row: blnID = True
            Else
                If blnID Then
                    ofs = ofs + 1
                    Cells(zeile, ofs) = var
                End If
            End If
        Else
            blnID = False
        End If
        Next
    End If
   
    rng.AutoFilter Field:=1, Criteria1:="<>ID *", Operator:=xlAnd
    rng.SpecialCells(xlCellTypeVisible).Rows.Delete shift:=xlShiftUp
    rng.AutoFilter
Set rng = Nothing
End Sub

Da die überflüssigen Zeilen auch gelöscht werden, also vorher eine Sicherungskopie anlegen, falls das nicht gewünscht wird...

[marbec75]

Hallo Ralf,

danke für deine schnelle Antwort. ich würde das gerne ohne Markos oder VB Code realisieren wollen. 
Ich habe gestern noch folgenden Code versucht , aber er funktioniert einfach nicht obwohl er von der Logik her richtig sein sollte:


=WENN(RECHTS(A1,1)="?",B1=A2,A2="")

Ist in Zeile A1 das letzte Zeichen ein ? dann verschiebe die Zeile darunter nach b1 (nächste zeile B2 usw.. ) solange bis wieder eine Zeile mit ID beginnt.
Ich kriege das nicht hin.
Weil es könnten auch 2-3 Antworten unter einer Frage sein....

[Elex]

Hi

Bezogen auf deine Bsp.Datei.

B4  =WENN(RECHTS(A4;1)="?";B3+1;B3) 
C4 =MTRANS(FILTER(A:A;(B:B=ZEILE(A1))*(A:A<>"")))
Formeln nach unten ziehen.

Gruß Elex

[maninweb]

Hallo,

eine Möglichkeit wäre, bezogen auf den Bereich A4:A11 in Deiner Beispieldatei, bspw. in A20. Setzt voraus, dass die erste Zeile mit ID beginnt.

PHP-Code:

=LET(Daten;$A$4:$A$11;D;FILTER(Daten;LÄNGE(GLÄTTEN(Daten))>0);T;TEXTVERKETTEN("";1;WENN(LINKS(D;2)<>"ID";"$";"|")&D);WEGLASSEN(TEXTTEILEN(T;"$";"|";0;0;"");1)) 


Für den Fall, dass Du wie in Deiner Beispieldatei die leeren Spalten zwischen den Antworten haben möchtest, geht auch:

PHP-Code:

=LET(Daten;$A$4:$A$11;D;FILTER(Daten;LÄNGE(GLÄTTEN(Daten))>0);T;TEXTVERKETTEN("";1;WENN(LINKS(D;2)<>"ID";"$";"|")&D);M;WEGLASSEN(TEXTTEILEN(T;"$";"|";0;0;"");1);
 MATRIXERSTELLEN(ZEILEN(M);2*(SPALTEN(M)-1);LAMBDA(X;Y;WENN(REST(Y;2)<1;INDEX(M;X;1+Y/2);WENN(Y<2;INDEX(M;X;1);""))))) 


Gruß

[Ralf A]

... ich würde das gerne ohne Markos oder VB Code realisieren wollen. 

Weshalb denn? 
Das hättest Du auch vorher sagen können, dann hätte ich mir die Arbeit nicht machen brauchen...

[snb]

Vermeide leere Zeilen end Spalten in Excel.
Und verwende VBA wo geeignet.

Code:

Sub M_snb()
   For Each it In Columns(1).SpecialCells(2).Areas
     If Left(it.Cells(1), 2) = "ID" Then
        sn = Application.Transpose(it.Offset(-1).Resize(it.Rows.Count + 1))
        sn(1) = Left(sn(2), InStr(sn(2), ":") - 1)
        sn(2) = Replace(sn(2), sn(1) & ": ", "")
        Cells(Rows.Count, 3).End(xlUp).Offset(1).Resize(, UBound(sn)) = sn
      End If
   Next
End Sub

[marbec75]

hi,

da erhalte ich eine Fehlermeldung. Siehe Bild.

[schauan]

Hallöchen,

eventuell hast Du die eine oder andere Funktion nicht. Nehme mal die lange Formel auseinander und probiere die Bestandteile soweit es geht, einzeln. Z.B. =WEGLASSEN(...) usw.

[snb]

Ohne Fehler: