Zelleninhalt aufteilen

[neverever000]

Hallo Forum,

ich habe folgendes Problem:

Bei meinem Programm lassen sich Daten leider nur in PDF exportieren.
Bei der Umwandlung von PDF in Excel entstehen leider Konvertierungsfehler. 
Und zwar werden Zeilen teilweise nicht aufgeteilt (siehe Datei: gelb markierte Felder).

Ich muss diese Datei jeden Monat erstellen. Gibt es eine möglichst aufwandsfreie Art die Zeilen untereinander aufzuteilen?
Z.B. mit Makros? Dabei dürfen keine Daten überschrieben werden. Außerdem befinden sich die Zeilen jeden Monat an einer
anderen Stelle. Excel müsste erkennen, dass sobald eine Zelle einen Umbruch enthält, diese untereinander aufgeteilt wird.
Idealerweise müssten die grauen Felder dabei ausgelassen werden. Ich kenne mich mit VBA leider nicht gut aus. 

Kann jemand freundlicherweise einen VBA-Code bzw. Makro für mich erstellen oder hat jemand eine Idee, wie ich das Problem 
am besten lösen kann?

Vielen Dank

[losgehts]

Hallo,

sorry, dass ich nochmal nachfrage, aber es will mir einfach nicht in den Kopf:
es gibt keine Möglichekeit, einfach die rohe Liste zu exportieren, also auch ohne die Summen und ohne die Kopfzeilen. Das stört doch einfach alles nur(?).

Sollen wirklich alle grauen Bereiche bleiben?

Grüße, Ulrich

[LCohen]

http://xxcl.de/bitteBeachten/ (Ergänzung: Wie heißt das Programm?)

[neverever000]

Hallo,

sorry, dass ich nochmal nachfrage, aber es will mir einfach nicht in den Kopf:
es gibt keine Möglichekeit, einfach die rohe Liste zu exportieren, also auch ohne die Summen und ohne die Kopfzeilen. Das stört doch einfach alles nur(?).

Sollen wirklich alle grauen Bereiche bleiben?

Grüße, Ulrich

Hallo Ulrich,

ich kann Deine Nachfrage nachvollziehen. Leider gibt es wirklich nur die Möglichkeit eines PDF Exports. Definitiv ein Mängel des Programms. 
Die grauen Bereiche müssen nicht bleiben. Hauptsache diese Bereiche werden nicht auch in Zellen aufgeteilt. 

Grüße, neverever000

[HKindler]

Hi,

wenn sich schon das PDF nicht vermeiden lässt, wäre es sinnvoll schon beim importieren einzugreifen und nicht erst nachträglich den missglückten Import zu korrigieren. Dazu müsste man aber die PDF-Datei haben.

[losgehts]

Hallo,

ich bin da ganz bei den anderen, dass man das auf jeden Fall anders versuchen sollte.

Dennoch habe ich mal ein Makro angefangen das als Ausgangsbasis dienen könnte. Bitte schau ganz genau, ob es auch das macht, was du willst, ich habe ein paar Entscheidungen getroffen .
Am besten Haltepunkte im Code festsetzen, und gleichzeitig die Tabelle im Blick haben. Und auch mal mit F8 "durchhoppeln", damit dir wirklich klar ist, was passiert.
Kannst es ja dann auch gleich an deine Bedürfnisse anpassen.

Code:

Option Explicit

Sub bereinigeUmbrueche()
Dim rngCell As Range, rngBelastKostenst As Range, rngVbLf As Range
Dim vartmp() As Variant, vals As Variant
Dim rowcounter As Long, i As Long, j As Long, iRow As Long

' ACHTUNG: dieser Code geht davon aus, dass die Zahlen in den Zellen, die aufgeteilt
'          werden sollen den Punkt als Dezimaltrennzeichen haben.
'          (Ob ein Komma als Tausendertrennzeichen dabei ist, ist irrelevant)


With ActiveSheet 'eigentlich unnötig, aber leichter anzupassen

    'Spalte der "zubelastenden Kostenstelle" finden: hier sind oft mehrzeilige Einträge,
    'die nicht betrachtet werden sollen.
    Set rngBelastKostenst = .Cells.Find("zu belastende", , , xlPart, xlByRows, xlNext)
    If rngBelastKostenst Is Nothing Then
        MsgBox "kann ""zu belastende"" (Kostenstelle) nicht finden. => Abbruch", vbCritical
        Exit Sub
    End If
    
    
    For iRow = .UsedRange.Rows.Count To 1 Step -1                           'die Tabelle wird von unten nach oben durchlaufen
    With .UsedRange.Rows(iRow)
        Set rngVbLf = .Cells.Find(vbLf, lookat:=xlPart)                     'Suche nach Zeilenumbruch (LF)
        If Not rngVbLf Is Nothing Then
            If rngVbLf.Column = rngBelastKostenst.Column Then GoTo NextRow  'nur "zu bel. Kostst." mehzeilig => nächste Zeile
            If .Cells.Find("Mandant", lookat:=xlPart) Is Nothing And _
                .Cells.Find("Kostenart", lookat:=xlPart) Is Nothing Then    'graue Kästen/Überschriften
                rowcounter = 0
                ReDim vartmp(1 To 100, 1 To 20)                             'alte Werte löschen
                For j = 1 To .Cells.Count                                   'Schleife über Zeile
                    If Len(.Cells(j).Value) = 0 Then
                        'leere Zelle => mach nichts
                    ElseIf InStr(.Cells(j).Value, vbLf) Then                'Zelle mit Zeilenumbruch
                        vals = Split(.Cells(j).Value, vbLf)                 'Zellinhalt aufteilen
                        
                        'Sicherstellen, dass alle Zellen die selbe Anzahl an Zeilen haben
                        If rowcounter = 0 Then
                            rowcounter = UBound(vals) + 1
                        Else
                            If rowcounter <> UBound(vals) + 1 Then
                                Application.Goto .Cells(1)
                                MsgBox "Zeile " & .Row & " kann nicht eindeutig aufgeteilt werden."
                                GoTo NextRow
                            End If
                        End If
                        
                        'Werte in einem Array zwischenspeichern
                        For i = 0 To UBound(vals)
                            vartmp(i + 1, j) = IIf(IsNumeric(vals(i)), Val(Replace(Replace(vals(i), ".", ""), ",", ".")), vals(i))
                        Next
                        
                    Else 'Zelle hat einzeiligen Inhalt
                        If j = rngBelastKostenst.Column Then
                            '"zu belastende Kostenstelle" allen Daten der Zeile zuweisen
                            For i = 1 To rowcounter
                                vartmp(i, j) = .Cells(j).Value
                            Next
                        Else
                            Application.Goto .Cells(1)
                            MsgBox "Zeile " & .Row & " kann nicht eindeutig aufgeteilt werden."
                            GoTo NextRow
                        End If
                    End If
                Next j 'Zelle in Zeile
                
                'Zeilen & Werte einfügen
                .Cells(1).Resize(rowcounter - 1, 1).EntireRow.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                .Cells(1).Offset(-rowcounter + 1, 0).Resize(rowcounter, .Cells.Count).Value = vartmp
                
                
            End If
        End If
NextRow:
    End With
    Next

End With

End Sub

Diese Zeilen werden aufgeteilt:
68 (nicht von dir markiert)
63 => Achtung: "zu belastende Kostenstelle"
62 => Achtung: "zu belastende Kostenstelle": ("deutsch. Lungenz." oder "deutsch'" | "Lungenz." ?)
61 => Achtung: "zu belastende Kostenstelle"
54 (nicht von dir markiert)
48 (nicht von dir markiert)
45

Grüße, Ulrich

[BoskoBiati]

Hi,

auf jeden Fall haben alle diese Zeilen eins gemeinsam: An der Position 7 befindet sich das Zeichen(10), also ein Zeilenumbruch.

[neverever000]

Hallo,

ich bin da ganz bei den anderen, dass man das auf jeden Fall anders versuchen sollte.

Dennoch habe ich mal ein Makro angefangen das als Ausgangsbasis dienen könnte. Bitte schau ganz genau, ob es auch das macht, was du willst, ich habe ein paar Entscheidungen getroffen .
Am besten Haltepunkte im Code festsetzen, und gleichzeitig die Tabelle im Blick haben. Und auch mal mit F8 "durchhoppeln", damit dir wirklich klar ist, was passiert.
Kannst es ja dann auch gleich an deine Bedürfnisse anpassen.

Code:

Option Explicit

Sub bereinigeUmbrueche()
Dim rngCell As Range, rngBelastKostenst As Range, rngVbLf As Range
Dim vartmp() As Variant, vals As Variant
Dim rowcounter As Long, i As Long, j As Long, iRow As Long

' ACHTUNG: dieser Code geht davon aus, dass die Zahlen in den Zellen, die aufgeteilt
'          werden sollen den Punkt als Dezimaltrennzeichen haben.
'          (Ob ein Komma als Tausendertrennzeichen dabei ist, ist irrelevant)


With ActiveSheet 'eigentlich unnötig, aber leichter anzupassen

    'Spalte der "zubelastenden Kostenstelle" finden: hier sind oft mehrzeilige Einträge,
    'die nicht betrachtet werden sollen.
    Set rngBelastKostenst = .Cells.Find("zu belastende", , , xlPart, xlByRows, xlNext)
    If rngBelastKostenst Is Nothing Then
        MsgBox "kann ""zu belastende"" (Kostenstelle) nicht finden. => Abbruch", vbCritical
        Exit Sub
    End If
   
   
    For iRow = .UsedRange.Rows.Count To 1 Step -1                           'die Tabelle wird von unten nach oben durchlaufen
    With .UsedRange.Rows(iRow)
        Set rngVbLf = .Cells.Find(vbLf, lookat:=xlPart)                     'Suche nach Zeilenumbruch (LF)
        If Not rngVbLf Is Nothing Then
            If rngVbLf.Column = rngBelastKostenst.Column Then GoTo NextRow  'nur "zu bel. Kostst." mehzeilig => nächste Zeile
            If .Cells.Find("Mandant", lookat:=xlPart) Is Nothing And _
                .Cells.Find("Kostenart", lookat:=xlPart) Is Nothing Then    'graue Kästen/Überschriften
                rowcounter = 0
                ReDim vartmp(1 To 100, 1 To 20)                             'alte Werte löschen
                For j = 1 To .Cells.Count                                   'Schleife über Zeile
                    If Len(.Cells(j).Value) = 0 Then
                        'leere Zelle => mach nichts
                    ElseIf InStr(.Cells(j).Value, vbLf) Then                'Zelle mit Zeilenumbruch
                        vals = Split(.Cells(j).Value, vbLf)                 'Zellinhalt aufteilen
                       
                        'Sicherstellen, dass alle Zellen die selbe Anzahl an Zeilen haben
                        If rowcounter = 0 Then
                            rowcounter = UBound(vals) + 1
                        Else
                            If rowcounter <> UBound(vals) + 1 Then
                                Application.Goto .Cells(1)
                                MsgBox "Zeile " & .Row & " kann nicht eindeutig aufgeteilt werden."
                                GoTo NextRow
                            End If
                        End If
                       
                        'Werte in einem Array zwischenspeichern
                        For i = 0 To UBound(vals)
                            vartmp(i + 1, j) = IIf(IsNumeric(vals(i)), Val(Replace(Replace(vals(i), ".", ""), ",", ".")), vals(i))
                        Next
                       
                    Else 'Zelle hat einzeiligen Inhalt
                        If j = rngBelastKostenst.Column Then
                            '"zu belastende Kostenstelle" allen Daten der Zeile zuweisen
                            For i = 1 To rowcounter
                                vartmp(i, j) = .Cells(j).Value
                            Next
                        Else
                            Application.Goto .Cells(1)
                            MsgBox "Zeile " & .Row & " kann nicht eindeutig aufgeteilt werden."
                            GoTo NextRow
                        End If
                    End If
                Next j 'Zelle in Zeile
               
                'Zeilen & Werte einfügen
                .Cells(1).Resize(rowcounter - 1, 1).EntireRow.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                .Cells(1).Offset(-rowcounter + 1, 0).Resize(rowcounter, .Cells.Count).Value = vartmp
               
               
            End If
        End If
NextRow:
    End With
    Next

End With

End Sub

Diese Zeilen werden aufgeteilt:
68 (nicht von dir markiert)
63 => Achtung: "zu belastende Kostenstelle"
62 => Achtung: "zu belastende Kostenstelle": ("deutsch. Lungenz."  oder  "deutsch'" | "Lungenz." ?)
61 => Achtung: "zu belastende Kostenstelle"
54 (nicht von dir markiert)
48 (nicht von dir markiert)
45

Grüße, Ulrich

Hallo Ulrich,

vielen Dank für Deine Hilfe. Ich bin beeindruckt.

Das hat mir sehr weitergeholfen.

Grüße, neverever000