Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

PDF Import aufsplitten
#1
Hallo Leute,
ich brauche auch mal wieder Hilfe.

Wir haben eine neue Brandmeldeanlage bekommen, die nach und nach die alte ersetzen soll.
Informationen bekomme ich nur als PDF. Wenn ich den gesamten Inhalt dieser PDF in ein Excel-sheet kopiere bekomme ich eine recht unübersichtliche Liste, die ich dann irgendwie aufsplitten muss.
Die Beispieldatei ist stark gekürzt. Im Original sind es bis jetzt knapp 10.000 Zeilen, und es wird im Laufe der nächsten paar Jahre auf das ca. 5-fache wachsen.
Da mit Sicherheit noch Fragen auftauchen schreib ich jetzt erst mal nicht weiter.
Wer Lust hat schaut einfach mal rein und hat hoffentlich Ideen wie man das umsetzen kann.

Danke erst mal im Voraus.

Igel


Angehängte Dateien
.xlsx   BMA.xlsx (Größe: 10,66 KB / Downloads: 10)
Ich kann nicht alles wissen,
aber vieles lernen ! 19
Antworten Top
#2
Hallo Igel,

sofern der neue Block (im Beispiel: 120 002 02) eindeutig zu identifizieren ist, sollte es relativ einfach machbar sein.

Sieh bitte nach, ob es immer 120 002 02 ist, oder immer ### ### ##. Die Anzahl der Zeilen spielt dann keine Rolle.

mfg
Antworten Top
#3
Hi Fen,
Der Block 120 002 02 besagt Zentrale 120, Baugruppe 002, Ring 02. Die Zahl in der nächsten Zeile besagt an welcher Stelle im Ring sich das Element befindet. Fazit: zumindest die Struktur ### ### ## ist fix. Die Zahlen darin ändern sich. Klar, ging aus dem Beispiel nicht hervor.
Danke schon mal.
Igel
Ich kann nicht alles wissen,
aber vieles lernen ! 19
Antworten Top
#4
Hast Du versucht, die PDF-Datei mit MS-Word zu öffnen? Ist die Struktur dort besser erhalten?
Antworten Top
#5
Habe ich probiert.
sieht in etwa genauso aus, außer dass die Schriftgrösse übernommen wird.
Das hilft aber nicht.
Ich kann nicht alles wissen,
aber vieles lernen ! 19
Antworten Top
#6
So, jetzt hab ich bald Feierabend/Wochenende.
Werde Montag wieder reinschauen und hoffe sehr ...
Bis dahin allen ein schönes Wochenende.

Gruss Igel
Ich kann nicht alles wissen,
aber vieles lernen ! 19
Antworten Top
#7
Es war doch etwas komplizierter als auf den ersten Blick gedacht.

Hier ein Entwurf bei dem noch ein oder zwei If-Abfragen verrutscht sind:

Code:
public RegEx as Object

Type Igel
    EP          As String
    Elem        As Integer
    Melde       As Integer
    EinzelM     As String
    Text        As String
    Besonder_1  As String
    Typ         As String
    Besonder_2  As String
    Art         As String
    Einstellung As String
End Type

Sub Vorbereitung() '             <<<<< einmal ausführen >>>>>>>
For i = 7 To Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(i, 1) Like "### ### ##" Then
        Cells(i, 2) = 1
    Else
        Cells(i, 2) = "a"
    End If
Next i
End Sub


Sub T_2()
Dim Ar(20) As Igel  '<<<<<<<<<< anpassen
Dim rng As Range
Set RegEx = CreateObject("vbscript.regexp")
RegEx.Pattern = "[A-Z]{2,}\d{3,}"

For Each rng In Range("B7:B100").SpecialCells(xlCellTypeConstants, 2).Areas
    Ar(r).EP = rng.Cells(1).Offset(-1, -1)
    Ar(r).Elem = rng.Cells(1).Offset(, -1)
    gr = Group(rng.Cells(2).Offset(, -1))
        Ar(r).Melde = gr(0)
        Ar(r).EinzelM = gr(1)
        Ar(r).Text = gr(2)
        Ar(r).Typ = gr(3)
    If Ar(r).Typ = "" Then
        Ar(r).Besonder_1 = rng.Cells(3).Offset(, -1)
        If Meldetyp(rng.Cells(4).Offset(, -1)) Then Ar(r).Typ = rng.Cells(4).Offset(, -1)
    Else
        Ar(r).Besonder_2 = rng.Cells(5).Offset(, -1)
        Ar(r).Art = rng.Cells(rng.Cells.Count).Offset(, 1)
    End If
    
    If rng.Cells(rng.Cells.Count) = "Standard Plus" Then
        Ar(r).Einstellung = "Standard Plus"
    Else
        Ar(r).Art = rng.Cells(rng.Cells.Count).Offset(, -1)
    End If
    
    r = r + 1
Next rng

'Ausgabe
With Sheets(2)
    For i = 0 To UBound(Ar)
        .Cells(i + 2, 1) = Ar(i).EP
        .Cells(i + 2, 2) = Ar(i).Elem
        .Cells(i + 2, 3) = Ar(i).Melde
        .Cells(i + 2, 4) = "'" & Ar(i).EinzelM
        .Cells(i + 2, 5) = Ar(i).Text
        .Cells(i + 2, 6) = Ar(i).Besonder_1
        .Cells(i + 2, 7) = Ar(i).Typ
        .Cells(i + 2, 8) = Ar(i).Besonder_2
        .Cells(i + 2, 9) = Ar(i).Art
        .Cells(i + 2, 10) = Ar(i).Einstellung
        
    Next i
End With

End Sub

Private Function Group(ByVal Tx As String)
Dim Out(3) As String
Dim Bo As Boolean

If Left(Tx, 4) Like "####" Then
    Out(0) = Left(Tx, 4)
    Out(1) = Mid(Tx, 6, 2)
Else
    Out(0) = 0
    Out(1) = Left(Tx, 2)
End If


If Meldetyp(Tx) Then
    Out(3) = RegEx.Execute(Tx)(0)
    Tx = Trim(Replace(Tx, Out(3), ""))
End If

Tx = Trim(Mid(Tx, Len(Out(0)) + 1))
Tx = Trim(Mid(Tx, Len(Out(1)) + 1))

Out(2) = Tx
Group = Out
End Function

Private Function Meldetyp(ByVal Str As String) As Boolean
    Meldetyp = RegEx.Test(Str)
End Function

Versuche mal, ob Du die Anpassungen hinbekommst.

mfg


Angehängte Dateien
.xlsm   BMA.xlsm (Größe: 26,65 KB / Downloads: 2)
Antworten Top
#8
Hallo,

das seit Excel 2016 immer vorhandene Power Query, kann seit diesem Jhar in der O365-Version auch direkt PDF-Dokumente importieren. Die, deiner Mappe entnehmbaren, Transformationsregeln, sollten sich mit Power Query recht einfach umsetzten lassen. Mittels des MS-Tools Flow, das wohl Unternehmenskunden von O365 immer kostenlos zur Verfügung steht, könntest du eingehende Mail-Anhänge direkt in einen bestimmten Order ablegen. Mit Power Query könntest du dann von diesem Ordern immer alle, nur bestimmte, nur die neuesten, automatisiert importieren.
VG, wisch
Wer Hilfe nimmt, sollte auch Hilfe geben! Auch wenn dies auf einem ganz anderem Gebiet geschieht.
Antworten Top
#9
Jetzt hab ich doch nochmal schnell reingeschaut.
#Fen, erst mal danke für die Mühe. Leider musste ich feststellen, dass unsere EDV neuerdings Download von xl.. blockt.
  Muss ich Montag klären.
#Wisch, mit PQ hab ich noch überhaupt keine Erfahrung. Wir haben auf der Arbeit Excel 2013.

Wie dem auch sei, ist erst mal Wochenende.
Bleibt gesund.  Bis Montag

Igel
Ich kann nicht alles wissen,
aber vieles lernen ! 19
Antworten Top
#10
Mit den Beispieldaten sollte es jetzt stimmem.

Code:
Private RegEx As Object

Private Type Igel
    EP          As String
    Elem        As Integer
    Melde       As Integer
    EinzelM     As String
    Text        As String
    Besonder_1  As String
    Typ         As String
    Besonder_2  As String
    Art         As String
    Einstellung As String
End Type

Sub Vorbereitung()
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(i, 1) Like "### ### ##" Then
        Cells(i, 2) = 1
    Else
        Cells(i, 2) = "a"
    End If
Next i
End Sub


Sub F_en()
Dim Ar() As Igel
Dim rng As Range
Set RegEx = CreateObject("vbscript.regexp")
RegEx.Pattern = "[A-Z]{2,}\d{3,}"

Sheets(1).Activate
ReDim Ar(Columns(2).SpecialCells(xlCellTypeConstants, 1).Count)

For Each rng In Columns(2).SpecialCells(xlCellTypeConstants, 2).Areas
    r = r + 1
    Ar(r).EP = rng.Cells(1).Offset(-1, -1)
    Ar(r).Elem = rng.Cells(1).Offset(, -1)
    gr = Group(rng.Cells(2).Offset(, -1))
        Ar(r).Melde = gr(0)
        Ar(r).EinzelM = gr(1)
        Ar(r).Text = gr(2)
        Ar(r).Typ = gr(3)
    If Ar(r).Typ = "" Then
        Ar(r).Besonder_1 = rng.Cells(3).Offset(, -1)
        If Meldetyp(rng.Cells(4).Offset(, -1)) Then Ar(r).Typ = rng.Cells(4).Offset(, -1)
    End If
    
    If rng.Cells(rng.Cells.Count).Offset(, -1) = "Standard Plus" Then
        Ar(r).Einstellung = "Standard Plus"
        Ar(r).Art = rng.Cells(rng.Cells.Count - 1).Offset(, -1)
    Else
        Ar(r).Art = rng.Cells(rng.Cells.Count).Offset(, -1)
    End If
      
    If Meldetyp(rng.Cells(2).Offset(, -1)) And rng.Cells(3).Offset(, -1) <> Ar(r).Art Then _
        Ar(r).Besonder_2 = rng.Cells(3).Offset(, -1)
Next rng

'Ausgabe
With Sheets(2)
    For i = 1 To UBound(Ar)
        .Cells(i + 1, 1) = Ar(i).EP
        .Cells(i + 1, 2) = Ar(i).Elem
        .Cells(i + 1, 3) = Ar(i).Melde
        .Cells(i + 1, 4) = "'" & Ar(i).EinzelM
        .Cells(i + 1, 5) = Ar(i).Text
        .Cells(i + 1, 6) = Ar(i).Besonder_1
        .Cells(i + 1, 7) = Ar(i).Typ
        .Cells(i + 1, 8) = Ar(i).Besonder_2
        .Cells(i + 1, 9) = Ar(i).Art
        .Cells(i + 1, 10) = Ar(i).Einstellung
        
    Next i
End With

End Sub


Private Function Group(ByVal Tx As String)
Dim Out(3) As String
Dim Bo As Boolean

If Left(Tx, 4) Like "####" Then
    Out(0) = Left(Tx, 4)
    Out(1) = Mid(Tx, 6, 2)
Else
    Out(0) = 0
    Out(1) = Left(Tx, 2)
End If


If Meldetyp(Tx) Then
    Out(3) = RegEx.Execute(Tx)(0)
    Tx = Trim(Replace(Tx, Out(3), ""))
End If

Tx = Trim(Mid(Tx, Len(Out(0)) + 1))
Tx = Trim(Mid(Tx, Len(Out(1)) + 1))

Out(2) = Tx
Group = Out
End Function

Private Function Meldetyp(ByVal Str As String) As Boolean
    Meldetyp = RegEx.Test(Str)
End Function

mfg


Angehängte Dateien
.xlsm   BMA.xlsm (Größe: 29,35 KB / Downloads: 3)
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste