Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1436to1440
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

Bereich mit Funktionen auf 2 Zeilen Aufteilen

Bereich mit Funktionen auf 2 Zeilen Aufteilen
31.07.2015 16:24:17
websnake75
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

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bereich mit Funktionen auf 2 Zeilen Aufteilen
31.07.2015 17:38:31
AlexG
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

Anzeige
Nachtrag
31.07.2015 17:50:39
AlexG
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

Anzeige
AW: Nachtrag
31.07.2015 18:38:42
Holz
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

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

Anzeige
AW: Nachtrag
31.07.2015 19:20:52
Holz
Ja genau Alex.

AW: Nachtrag
01.08.2015 09:52:23
AlexG
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

Anzeige
AW: Nachtrag
01.08.2015 11:18:40
websnake75
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

AW: Nachtrag
02.08.2015 20:10:22
Holz
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

Anzeige
AW: Nachtrag
02.08.2015 20:43:17
AlexG
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

Anzeige
AW: Nachtrag
02.08.2015 21:20:02
Holz
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

AW: Nachtrag
02.08.2015 21:27:13
AlexG
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

Anzeige
AW: Nachtrag
02.08.2015 21:46:24
Holz
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

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

AW: Nachtrag
02.08.2015 19:11:05
Holz
Ja genau Alex.

306 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige