Soru PDF dosyasından veriyi sistematik şekilde excel dosyasına almak

seckinb · 13 Şubat 2021

size örnek dosyanın gerçek halini özelden mail atıyorum.
modifiye dosya ile aynı şekilde çalışmıyor.

Haluk · 13 Şubat 2021

Özelden birşey kabul etmiyorum ....

.

seckinb · 13 Şubat 2021

Hasta verisini gizlemek adına formu çok sadeleştirmişim.
Örnek aynı şekilde çalışmıyor.
Burada sadece hasta adı değiştirildi.
bende tüm veri üst üste çıkıyor ne yazık ki.

Haluk · 13 Şubat 2021

Ekli çalışmada, hem ilk verdiğiniz PDF hem de son verdiğiniz PDF'den veriler alınabilmekte....

Görseli de aşağıdadır....

Haluk · 13 Şubat 2021

Aşağıdaki kod ise; e-posta mesajınızda gerçek verileri içeren dosya olduğunu belirttiğiniz PDF'e göre hazırlandı...

C#:

Sub Test3()
    Dim FSO As Object, dosya As Variant, pdfDoc As PDFDocument, pages As PDFPageCollection
    Dim t As Byte, folderPath As String
    Dim RegExp As Object, valData As Variant, RetVal As Variant
    Dim arrPattern(1 To 9) As String
    Dim txtPDF As String, tempData As String
    Dim NoA As Integer, i As Integer, arrIndex As Integer
  
    Set FSO = CreateObject("Scripting.FileSystemObject")
    folderPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\pdf"
  
    i = 1
    For Each dosya In FSO.GetFolder(folderPath).Files
        If LCase(FSO.GetExtensionName(dosya)) = "pdf" Then
            NoA = Range("A" & Rows.Count).End(xlUp).Row + 1
            Set pdfDoc = New PDFDocument
            Set pages = pdfDoc.OpenPdf(dosya)
          
            For t = 0 To pages.Count - 1
                txtPDF = txtPDF & WorksheetFunction.Trim(pages(t).GetText) & vbCrLf
            Next
          
            txtPDF = Replace(txtPDF, vbLf, "")
          
            arrPattern(1) = "\bHasta Adı:(.+)\s(\d{1,2}\.\d{1,2}\.\d{4})\b"
            arrPattern(2) = "\s\d{1,2}\.\d{1,2}\.\d{4}\s*(.+)\sYaş:"
            arrPattern(3) = "\s*(\d{1,2}\.\d{1,2}\.\d{4})"
            arrPattern(4) = "Protokol No:\s*(\d+)"
            arrPattern(5) = "SUT Kodu:\s*\d{1,3}(.+)Tetkik"
            arrPattern(6) = "Tetkik:\s*(.+)ENDİKASYON:"
            arrPattern(7) = "ENDİKASYON:\s*(.+)BULGULAR:"
            arrPattern(8) = "BULGULAR:\s*(.+)SONUÇ:"
            arrPattern(9) = "SONUÇ:\s*(.+)$"
          
            Set RegExp = CreateObject("VBScript.RegExp")
          
            RegExp.IgnoreCase = True
            RegExp.Global = True
            RegExp.MultiLine = True
          
            i = Range("A" & Rows.Count).End(xlUp).Row + 1
            arrIndex = 0
            For Each valData In arrPattern
                RegExp.Pattern = valData
                arrIndex = arrIndex + 1
                If RegExp.Test(txtPDF) Then
                    For Each RetVal In RegExp.Execute(txtPDF)
                        tempData = RetVal.Submatches(0)
                        If arrIndex = 1 Then
                            Range("A" & i) = tempData
                        ElseIf arrIndex = 2 Then
                            Range("B" & i) = tempData
                        ElseIf arrIndex = 3 Then
                            Range("C" & i) = tempData
                        ElseIf arrIndex = 4 Then
                            Range("D" & i) = tempData
                        ElseIf arrIndex = 5 Then
                            Range("E" & i) = tempData
                        ElseIf arrIndex = 6 Then
                            Range("F" & i) = tempData
                        ElseIf arrIndex = 7 Then
                            Range("G" & i) = tempData
                        ElseIf arrIndex = 8 Then
                            Range("H" & i) = tempData
                        ElseIf arrIndex = 9 Then
                            Range("I" & i) = tempData
                        End If
                    Next
                End If
            Next
        End If
        txtPDF = ""
    Next
    Set RegExp = Nothing
    pdfDoc.ClosePdf
    Set pages = Nothing
    Set pdfDoc = Nothing
    Set FSO = Nothing
End Sub

.

seckinb · 13 Şubat 2021

Elinize sağlık.
Formu bir programdan çıktı olarak alıyorum.
Şu an işimi görecek kadar çalıştı.
Emeklerinize sağlık.

tamer42 · 13 Mart 2021

Haluk' Alıntı:
Tetkik, endikasyonlar, bulgu, sonuç .... hepsini ekledim.

.

Haluk Hocam merhaba,
Bu PDF dosyasının içeriğinde yazanları herhangi bir kritere bağlı kalmaksınız, ne var- ne yoksa satır- satır (yukarıdan aşağıya) excel ortamına akmak için nasıl bir düzenleme yapmak gerekir?
özetle PDF dosyası bire-bir excel sayfasına alınacak

daha sonra düzenleme excel içinde yapılabiliriz.

ilginize şimdiden teşekkürler,
iyi akşamalar.

tamer42 · 13 Mart 2021

tamer42' Alıntı:
Haluk Hocam merhaba,
Bu PDF dosyasının içeriğinde yazanları herhangi bir kritere bağlı kalmaksınız, ne var- ne yoksa satır- satır (yukarıdan aşağıya) excel ortamına akmak için nasıl bir düzenleme yapmak gerekir?
özetle PDF dosyası bire-bir excel sayfasına alınacak

daha sonra düzenleme excel içinde yapılabiliriz.

ilginize şimdiden teşekkürler,
iyi akşamalar.

Haluk' Alıntı:

Aşağıdaki kod ise; e-posta mesajınızda gerçek verileri içeren dosya olduğunu belirttiğiniz PDF'e göre hazırlandı...

Ekli dosyayı görüntüle 225253

C#:

Sub Test3()
    Dim FSO As Object, dosya As Variant, pdfDoc As PDFDocument, pages As PDFPageCollection
    Dim t As Byte, folderPath As String
    Dim RegExp As Object, valData As Variant, RetVal As Variant
    Dim arrPattern(1 To 9) As String
    Dim txtPDF As String, tempData As String
    Dim NoA As Integer, i As Integer, arrIndex As Integer
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    folderPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\pdf"
 
    i = 1
    For Each dosya In FSO.GetFolder(folderPath).Files
        If LCase(FSO.GetExtensionName(dosya)) = "pdf" Then
            NoA = Range("A" & Rows.Count).End(xlUp).Row + 1
            Set pdfDoc = New PDFDocument
            Set pages = pdfDoc.OpenPdf(dosya)
         
            For t = 0 To pages.Count - 1
                txtPDF = txtPDF & WorksheetFunction.Trim(pages(t).GetText) & vbCrLf
            Next
         
            txtPDF = Replace(txtPDF, vbLf, "")
         
            arrPattern(1) = "\bHasta Adı:(.+)\s(\d{1,2}\.\d{1,2}\.\d{4})\b"
            arrPattern(2) = "\s\d{1,2}\.\d{1,2}\.\d{4}\s*(.+)\sYaş:"
            arrPattern(3) = "\s*(\d{1,2}\.\d{1,2}\.\d{4})"
            arrPattern(4) = "Protokol No:\s*(\d+)"
            arrPattern(5) = "SUT Kodu:\s*\d{1,3}(.+)Tetkik"
            arrPattern(6) = "Tetkik:\s*(.+)ENDİKASYON:"
            arrPattern(7) = "ENDİKASYON:\s*(.+)BULGULAR:"
            arrPattern(8) = "BULGULAR:\s*(.+)SONUÇ:"
            arrPattern(9) = "SONUÇ:\s*(.+)$"
         
            Set RegExp = CreateObject("VBScript.RegExp")
         
            RegExp.IgnoreCase = True
            RegExp.Global = True
            RegExp.MultiLine = True
         
            i = Range("A" & Rows.Count).End(xlUp).Row + 1
            arrIndex = 0
            For Each valData In arrPattern
                RegExp.Pattern = valData
                arrIndex = arrIndex + 1
                If RegExp.Test(txtPDF) Then
                    For Each RetVal In RegExp.Execute(txtPDF)
                        tempData = RetVal.Submatches(0)
                        If arrIndex = 1 Then
                            Range("A" & i) = tempData
                        ElseIf arrIndex = 2 Then
                            Range("B" & i) = tempData
                        ElseIf arrIndex = 3 Then
                            Range("C" & i) = tempData
                        ElseIf arrIndex = 4 Then
                            Range("D" & i) = tempData
                        ElseIf arrIndex = 5 Then
                            Range("E" & i) = tempData
                        ElseIf arrIndex = 6 Then
                            Range("F" & i) = tempData
                        ElseIf arrIndex = 7 Then
                            Range("G" & i) = tempData
                        ElseIf arrIndex = 8 Then
                            Range("H" & i) = tempData
                        ElseIf arrIndex = 9 Then
                            Range("I" & i) = tempData
                        End If
                    Next
                End If
            Next
        End If
        txtPDF = ""
    Next
    Set RegExp = Nothing
    pdfDoc.ClosePdf
    Set pages = Nothing
    Set pdfDoc = Nothing
    Set FSO = Nothing
End Sub

.

Haluk Hocam Merhaba,

Ekli dosyada yer alan verileri buradaki kodları kullanarak Tablo halinde excel' e almaya çalışıyorum, fakat pek beceremedim, yardımcı olursanız çok makbule geçecek.

iyi haftasonları.

Haluk · 13 Mart 2021

Zorlanıyorsanız, online çözüm sunan siteleri kullanın...

The Best All-In-One Free Online PDF Solution.

HiPDF is a web application that easily edits, converts and organize PDFs while keeping data safe and secure, processing tens of millions of files cumulatively.

www.hipdf.com

.

tamer42 · 13 Mart 2021

Haluk' Alıntı:
Zorlanıyorsanız, online çözüm sunan siteleri kullanın...

The Best All-In-One Free Online PDF Solution.

HiPDF is a web application that easily edits, converts and organize PDFs while keeping data safe and secure, processing tens of millions of files cumulatively.

www.hipdf.com

.

Haluk Hocam excel' de çözüm varken, online sitelere gitmeye gerek yok diye düşünüyorum,
benim zorlandığım kısım : RegExp = CreateObject("VBScript.RegExp") kısmı,

değilse veriler bir şekilde geliyor, fakat karışık durumda, bunlar daha düzenli gelsin istiyorum

aşağıdaki patern iki ifadenin (a1-b1) arasını getirir değil mi?

Kod:

a1="Kanunen Kabul Edilmeyen Giderler"
b1="Kar ve İlaveler Toplamı"
 arrPattern(1) = a1 & "\s*(.+)" & b1

Haluk · 14 Mart 2021

PDF dosyanızı incelemedim, ama en son verdiğiniz örneğin simülasyonunu eğer şöyle birşeyse;

C++:

     Kanunen Kabul Edilmeyen Giderler      125,36
     Kar ve İlaveler Toplamı               105,69

ve siz, burada KKEG verisi olan 125,36 değerini elde etmek istiyorsanız;

C++:

Sub Test()
'   Haluk - 14/03/2021
'   sa4truss@gmail.com
'
    Dim regExp As Object, objMatches As Object
    Dim myStr As String, i As Long
   
    myStr = "Kanunen Kabul Edilmeyen Giderler      125,36" & vbCrLf & _
            "Kar ve İlaveler Toplamı               105,69"
   
    MsgBox myStr
   
    Set regExp = CreateObject("VBScript.RegExp")
    regExp.IgnoreCase = True
    regExp.MultiLine = True
    regExp.Global = True
    regExp.Pattern = "Kanunen Kabul Edilmeyen Giderler\s*(.+)[\n\r]"
   
    If regExp.Test(myStr) Then
        Set objMatches = regExp.Execute(myStr)
        MsgBox objMatches.Item(0).Submatches(0) + 0
    End If
   
    Set regExp = Nothing
    Set objMatches = Nothing
End Sub

.

tamer42 · 14 Mart 2021

Haluk' Alıntı:

PDF dosyanızı incelemedim, ama en son verdiğiniz örneğin simülasyonunu eğer şöyle birşeyse;

C++:

     Kanunen Kabul Edilmeyen Giderler      125,36
     Kar ve İlaveler Toplamı               105,69

ve siz, burada KKEG verisi olan 125,36 değerini elde etmek istiyorsanız;

C++:

Sub Test()
'   Haluk - 14/03/2021
'   sa4truss@gmail.com
'
    Dim regExp As Object, objMatches As Object
    Dim myStr As String, i As Long
  
    myStr = "Kanunen Kabul Edilmeyen Giderler      125,36" & vbCrLf & _
            "Kar ve İlaveler Toplamı               105,69"
  
    MsgBox myStr
  
    Set regExp = CreateObject("VBScript.RegExp")
    regExp.IgnoreCase = True
    regExp.MultiLine = True
    regExp.Global = True
    regExp.Pattern = "Kanunen Kabul Edilmeyen Giderler\s*(.+)[\n\r]"
  
    If regExp.Test(myStr) Then
        Set objMatches = regExp.Execute(myStr)
        MsgBox objMatches.Item(0).Submatches(0) + 0
    End If
  
    Set regExp = Nothing
    Set objMatches = Nothing
End Sub

.

Haluk Hocam ilginize teşekkürler,

Burada vermiş olduğunuz
regExp.Pattern = "Kanunen Kabul Edilmeyen Giderler\s*(.+)[\n\r]"

ifadesini ekli dosyada Module2 de PDF' den veri çekme işlemi için uygulamaya çalıştım fakat hata alıyorum,

Kod:

   arrPattern(1) = "Kanunen Kabul Edilmeyen Giderler\s*(.+)[\n\r]"

nasıl bir düzenleme yapabiliriz? Yardımcı olabilirseniz sevinirim.
iyi akşamlar.

Haluk · 14 Mart 2021

Kodlarda aşağıdaki satırı iptal ederseniz, KKEG değerini yakalarsınız ama diğerlerini değil.

Kod:

txtPDF = Replace(txtPDF, vbLf, " ")

Sizin PDF'in içeriği, "text" olarak aşağıda şekilde ..... bunu "RegEx" ile çözümlemek için vakit harcamak gerekir.

Kod:

Kanunen Kabul Edilmeyen Giderler 74.822,68



1.425.553,17



ZARAR

KARCari Yıla Ait Zarar, İstisna ve İndirimler ToplamıKar ve İlaveler Toplamı



0,000,00



1.425.553,17

Diğer Geçmiş Yıl Zararları 1.289.920,01

İstisnadan Kaynaklanan Geçmiş Yıl Zararları 0,00

.

tamer42 · 15 Mart 2021

Haluk' Alıntı:
Kodlarda aşağıdaki satırı iptal ederseniz, KKEG değerini yakalarsınız ama diğerlerini değil.

Kod:

txtPDF = Replace(txtPDF, vbLf, " ")

Sizin PDF'in içeriği, "text" olarak aşağıda şekilde ..... bunu "RegEx" ile çözümlemek için vakit harcamak gerekir.

Kod:

Kanunen Kabul Edilmeyen Giderler 74.822,68 1.425.553,17 ZARAR KARCari Yıla Ait Zarar, İstisna ve İndirimler ToplamıKar ve İlaveler Toplamı 0,000,00 1.425.553,17 Diğer Geçmiş Yıl Zararları 1.289.920,01 İstisnadan Kaynaklanan Geçmiş Yıl Zararları 0,00

.

haluk hocam merhaba,
Bu şekilde verileri almak zor olacak anladığım kadarıyla;
PDF dosyasındaki tüm verileri satır ve sütun olarak yukarıdan aşağıya excel sayfasına alması da benim işimi görür, excel ortamına aldıktan sonra iş artık kolay;
bu şekilde yardımcı olabilir misiniz
iyi haftalar, iyi çalışmalar.

tamer42 · 29 Mayıs 2021

Haluk' Alıntı:
Ekli çalışmada, hem ilk verdiğiniz PDF hem de son verdiğiniz PDF'den veriler alınabilmekte....

Görseli de aşağıdadır....

Ekli dosyayı görüntüle 225245

Haluk Hocam merhaba,

Ekli PDF dosyasının içeriğinde yazanları ve görselleri satır ve sütun olarak tablo halinde excel ortamına akmak için nasıl bir düzenleme yapmak gerekir?

istedğim PDF dosyası içerğini benzer şekilde excel sayfasına alınacak, görseller alınırsa iyi olur, alınmazsa da sorun değil

ilgi ve alakanız şimdiden teşekkürler,
iyi haftasonları....

Soru PDF dosyasından veriyi sistematik şekilde excel dosyasına almak

seckinb

Haluk

𐱅𐰇𐰼𐰚

seckinb

Ekli dosyalar

Haluk

𐱅𐰇𐰼𐰚

Ekli dosyalar

Haluk

𐱅𐰇𐰼𐰚

seckinb

tamer42

Destek Ekibi

Ekli dosyalar

tamer42

Destek Ekibi

Ekli dosyalar

Haluk

𐱅𐰇𐰼𐰚

The Best All-In-One Free Online PDF Solution.

tamer42

Destek Ekibi

The Best All-In-One Free Online PDF Solution.

Haluk

𐱅𐰇𐰼𐰚

tamer42

Destek Ekibi

Ekli dosyalar

Haluk

𐱅𐰇𐰼𐰚

tamer42

Destek Ekibi

tamer42

Destek Ekibi

Ekli dosyalar