Bereich mit Funktionen auf 2 Zeilen Aufteilen

Bild

Betrifft: Bereich mit Funktionen auf 2 Zeilen Aufteilen
von: websnake75
Geschrieben am: 31.07.2015 16:24:17

Hallo,
ich komme in meiner Excel-Datei ohne Macro nicht weiter.
Ich habe in meinem Excel-Dokument mehrere Tabellenblätter:
1. Erfassung = Eingabe durch den Benutzer
2. Datenschnittstelle = hier werden die Daten aus Erfassung und Admin mit Funktionen aufbereitet, damit sie einer Datenschnittstelle entsprechen wenn ich das Tabellenblatt als txt (durch Tabstop getrennt) abspeicher.
3. Admin = Hilfsblatt für Datenschnittstelle
Nun das Problem:
In Datenschnittstelle sind die Daten passend zu jeder Eingabezeile aus Erfassung aufbereitet. Soll heißen, Datensatz aus Erfassung Zeile1 = Datensatz in Datenschnittstelle Zeile 1 usw.
Jetzt ist es aber erforderlich, dass in einem neuen Tabellenblatt (z.B. Export) die Daten bzw. Funktionen ab der Spalte AA eine Zeile nach unten versetzt werden müssen.
Also Zeile1 aus Datenschnittstelle teilt sich in Zeile1 und Zeile2 in Export
Zeile2 aus Datenschnittstelle teilt sich in Zeile3 und Zeile4 in Export
usw.
und das solange, bis aus Datenschnittstelle alle Zeilen aufgeteilt sind.
Die Zeilen in Datenschnittstelle sind jeden Monat unterschiedlich lang.
Kann mir jemand bei diesem Problem helfen?
Viele Grüße
Ronald
https://www.herber.de/bbs/user/99218.xlsx

Bild

Betrifft: AW: Bereich mit Funktionen auf 2 Zeilen Aufteilen
von: AlexG
Geschrieben am: 31.07.2015 17:38:31
Hallo Ronald,
So?

Sub Export()
Dim i&, j&, k&, lngZ&, lngS&
Dim wsQ, wsZ As Worksheet
Set wsQ = Sheets("Datenschnittstelle")
Set wsZ = Sheets("Export")
lngZ = wsQ.Cells(Rows.Count, 1).End(xlUp).Row
Debug.Print lngZ
lngS = wsQ.Cells(2, Columns.Count).End(xlToLeft).Column
Debug.Print lngS
k = 3
For i = 2 To lngZ
    For j = 1 To lngS
        If j > 26 Then
            wsZ.Cells(k + 1, j - 26) = wsQ.Cells(i, j)
        Else
            wsZ.Cells(k, j) = wsQ.Cells(i, j)
        End If
    Next j
    k = k + 2
Next i
End Sub
https://www.herber.de/bbs/user/99221.xlsm
Gruß
Alex

Bild

Betrifft: Nachtrag
von: AlexG
Geschrieben am: 31.07.2015 17:50:39
Hallo Ronald,
Ich habe noch den Debug.Print entfernt.
Noch eine Frage, warum hast du im Blatt Datenschnittstelle oben eine leere Zeile drin?

Sub Export()
Dim i&, j&, k&, lngZ&, lngS&
Dim wsQ, wsZ As Worksheet
Set wsQ = Sheets("Datenschnittstelle")
Set wsZ = Sheets("Export")
lngZ = wsQ.Cells(Rows.Count, 1).End(xlUp).Row
lngS = wsQ.Cells(2, Columns.Count).End(xlToLeft).Column
k = 3
For i = 2 To lngZ
    For j = 1 To lngS
        If j > 26 Then
            wsZ.Cells(k + 1, j - 26) = wsQ.Cells(i, j)
        Else
            wsZ.Cells(k, j) = wsQ.Cells(i, j)
        End If
    Next j
    k = k + 2
Next i
End Sub
https://www.herber.de/bbs/user/99223.xlsm
Gruß
Alex

Bild

Betrifft: AW: Nachtrag
von: Holz
Geschrieben am: 31.07.2015 18:38:42
Hallo Alex,
erstmal vielen Dank für Deine Hilfe.
Jetzt wo Du nach der ersten zeile fragst, die hab ich gar nicht erwähnt. Aber da ist ganz vorne auch schon ein Header vom Datensatz drin. der muss stehen bleiben. Es geht also erst ab Zeile2 mit dem teilen los. Die Zeile1 sollte im Idealfall 1 zu 1 kopiert werden.
Und dann sind ein paar Sachen verloren gegangen z.B.
Datenschnittstelle SpalteD 004988
in Export SpalteD 4988
die Nullen brauche ich.
Und die Datenschnittstelle geht bis Spalte BP.
Kannst Du das noch korrigieren?
Gruß
Ronald

Bild

Betrifft: AW: Nachtrag
von: AlexG
Geschrieben am: 31.07.2015 19:03:30
Hallo Ronald,
Sollen die Daten die in die "zweite" Zeile geschrieben werden dann ab Spalte AA in die "dritte" Zeile geschrieben werden?
Gruß
Alex

Bild

Betrifft: AW: Nachtrag
von: Holz
Geschrieben am: 31.07.2015 19:20:52
Ja genau Alex.

Bild

Betrifft: AW: Nachtrag
von: AlexG
Geschrieben am: 01.08.2015 09:52:23
Guten Morgen Ronald,
dann so

Sub Export()
Dim i&, j&, k&, lngZ&, lngS&
Dim wsQ, wsZ As Worksheet
Set wsQ = Sheets("Datenschnittstelle")
Set wsZ = Sheets("Export")
lngZ = wsQ.Cells(Rows.Count, 1).End(xlUp).Row
lngS = 68
k = 3
For i = 2 To lngZ
    For j = 1 To lngS
        If j > 52 Then
            wsZ.Cells(k + 2, j - 52) = "'" & wsQ.Cells(i, j).Text
        ElseIf j > 26 Then
            wsZ.Cells(k + 1, j - 26) = "'" & wsQ.Cells(i, j).Text
        Else
            wsZ.Cells(k, j) = wsQ.Cells(i, j).Text
        End If
    Next j
    k = k + 3
Next i
End Sub
Gruß
Alex

Bild

Betrifft: AW: Nachtrag
von: websnake75
Geschrieben am: 01.08.2015 11:18:40
Hallo Alex,
Ich bin am Wochenende unterwegs und kann es mir deshalb erst morgen Abend ansehen.
Aber schon einmal vielen Dank für Deine Mühe.
Gruß
Ronald

Bild

Betrifft: AW: Nachtrag
von: Holz
Geschrieben am: 02.08.2015 20:10:22
Hallo Alex,
ich habe mal das neue Makro getestet. Leider bekomme ich noch nicht das gewünschte Ergebnis.
1. die Zeile1 von Datenschnitstelle wird nicht 1 zu 1 kopiert
2. in der jeweiligen Zeile mit der 112 am Anfang wird das Format geändert, in SpalteD gehen z.B. wieder 2 Nullen verloren
3. die Zeilen werden nicht bis BP ausgewertet
Ich habe versucht das Makro anzupassen, bekomme aber einen Laufzeitfehler.
Ich packe mal ein Zip-Archiv mit rein.
1. die Textdatei manuell, so wir sie aussehen sollte
2. die Textdatei mit Makro, da sieht man wie die Daten durch das Makro exportiert aussehen
3. ein Exceldokument mit dem ich jetzt den Export gemacht habe
Kannst Du Dir das bitte noch einmal ansehen?
Gruß
Ronald
https://www.herber.de/bbs/user/99257.zip

Bild

Betrifft: AW: Nachtrag
von: AlexG
Geschrieben am: 02.08.2015 20:43:17
Hallo Ronald,
ich hoffe es entspricht deinen WÜnschen.

Sub Export()
Dim i&, j&, k&, lngZ&, lngS&
Dim wsQ, wsZ As Worksheet
Set wsQ = Sheets("Datenschnittstelle")
Set wsZ = Sheets("Export")
lngZ = wsQ.Cells(Rows.Count, 1).End(xlUp).Row
lngS = 68
k = 2
Application.ScreenUpdating = False
wsQ.Range("A1:K1").Copy wsZ.Range("A1:K1")
For i = 2 To lngZ
    For j = 1 To lngS
        If j > 52 Then
            wsZ.Cells(k + 2, j - 52).NumberFormat = "@"
            wsZ.Cells(k + 2, j - 52) = "'" & wsQ.Cells(i, j).Text
        ElseIf j > 26 Then
            wsZ.Cells(k + 1, j - 26).NumberFormat = "@"
            wsZ.Cells(k + 1, j - 26) = "'" & wsQ.Cells(i, j).Text
        Else
            wsZ.Cells(k, j).NumberFormat = "@"
            wsZ.Cells(k, j) = wsQ.Cells(i, j).Text
        End If
    Next j
    k = k + 3
Next i
Application.ScreenUpdating = True
End Sub
Gruß
Alex

Bild

Betrifft: AW: Nachtrag
von: Holz
Geschrieben am: 02.08.2015 21:20:02
Hallo Alex,
die Zeile mit der 117 muss länger sein. Er macht jetzt ab der 26 Spalte Schluss und erstellt eine Zeile3.
Bekommst Du das auch noch hin?
Gruß
Ronald

Bild

Betrifft: AW: Nachtrag
von: AlexG
Geschrieben am: 02.08.2015 21:27:13
Hallo Ronald,
du wolltest dass nach Spalte Z eine neue Zeile beschrieben wird. So wie sich das jetzt anhört soll die erste kopierte Zeile bis Spalte Z gehen und der Rest dann in Zeile 2 stehen.
das sieht dann so aus. Oder habe ich dich wieder falsch verstanden?

Sub Export()
Dim i&, j&, k&, lngZ&, lngS&
Dim wsQ, wsZ As Worksheet
Set wsQ = Sheets("Datenschnittstelle")
Set wsZ = Sheets("Export")
lngZ = wsQ.Cells(Rows.Count, 1).End(xlUp).Row
lngS = 68
k = 2
Application.ScreenUpdating = False
wsQ.Range("A1:K1").Copy wsZ.Range("A1:K1")
For i = 2 To lngZ
    For j = 1 To lngS
        If j > 26 Then
            wsZ.Cells(k + 1, j - 26).NumberFormat = "@"
            wsZ.Cells(k + 1, j - 26) = wsQ.Cells(i, j).Text
        Else
            wsZ.Cells(k, j).NumberFormat = "@"
            wsZ.Cells(k, j) = wsQ.Cells(i, j).Text
        End If
    Next j
    k = k + 2
Next i
Application.ScreenUpdating = True
End Sub
Gruß
Alex

Bild

Betrifft: AW: Nachtrag
von: Holz
Geschrieben am: 02.08.2015 21:46:24
Alex, jetzt ist es perfekt!
Vielen, vielen Dank.
Das hilft mir sehr.
Und entschuldige bitte, dass ich mich nicht exakt geäußert habe, was genau ich möchte.
Gruß
Ronald

Bild

Betrifft: Bitte
von: AlexG
Geschrieben am: 02.08.2015 22:09:11
Hallo Ronald,
Freut mich das es jetzt passt.
Und danke für die Rückmeldung.
Gruß
Alex

Bild

Betrifft: AW: Nachtrag
von: Holz
Geschrieben am: 02.08.2015 19:11:05
Ja genau Alex.

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Bereich mit Funktionen auf 2 Zeilen Aufteilen"