PDF to Excel - Bestimmte Ziffernfolge suchen

Forumthread: PDF to Excel - Bestimmte Ziffernfolge suchen

16.02.2016 10:16:19

Thorsten

Hallo,
ich habe eine PDF in ein Textdokument gespeichert und nun in Excel kopiert.
Hierbei habe ich ja die Möglichkeit Text in Spalten aufzuteilen.
Jetzt ist es so das ich alles in einer Spalte habe (A) und jeweils die Zeilen 1-...!
Es gibt Nummern in diesem Text in folgender Form (## #### ####).
Diese möchte ich gesammelt im Dokument suchen, kopieren und eine Liste von Nr. haben, die im Dokument vorkommen.
Die Nummern stehen oftmals nicht allein sondern sind umgeben von Text usw.
Ist das Möglich?
Vielen Dank!

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: PDF to Excel - Bestimmte Ziffernfolge suchen

18.02.2016 15:15:44

fcs

AW: PDF to Excel - Bestimmte Ziffernfolge suchen

18.02.2016 15:15:44

fcs

Hallo Thorsten,
hier ein entsprechendes Suchmakro.
Gruß
Franz

Sub SucheZahlenmuster()
Dim wks As Worksheet
Dim Zeile As Long, Zeile1 As Long
Dim strZelle As String, strText As String
Dim intK As Integer
Dim arrZahlen() As String, intZ As Integer
Dim strLike As String
Set wks = ActiveSheet
strLike = "## #### ####" 'Vergleichsstring # steht für Ziffer
With wks
For Zeile = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
strZelle = .Cells(Zeile, 1).Text
For intK = 1 To Len(strZelle)
strText = Mid(strZelle, intK)
If Left(strText, Len(strLike)) Like strLike Then
intZ = intZ + 1
ReDim Preserve arrZahlen(1 To intZ)
arrZahlen(intZ) = Left(strText, Len(strLike))
intK = intK + Len(strLike) - 1
End If
Next
Next
End With
If intZ > 0 Then
Application.ScreenUpdating = False
'neues Blatt für Ergebnis anlegen
ActiveWorkbook.Worksheets.Add after:=wks
Set wks = ActiveSheet
With wks
Zeile1 = 2 '1. EInfügezeile für Zahlenfolgen
Zeile = Zeile1 - 1
For intZ = LBound(arrZahlen) To UBound(arrZahlen)
Zeile = Zeile + 1
.Cells(Zeile, 1).Value = arrZahlen(intZ)
Next
If Zeile > Zeile1 Then
'Zahlen sortieren
With .Range(.Cells(Zeile1, 1), .Cells(Zeile, 1))
.Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlNo
End With
'mehrfach vorkommende Ziffernfolgen löschen
For Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row To Zeile1 + 1 Step -1
If .Cells(Zeile, 1).Text = .Cells(Zeile - 1, 1).Text Then
.Cells(Zeile, 1).EntireRow.Delete
End If
Next
End If
End With
Application.ScreenUpdating = True
Else
MsgBox "Keine Ziffernfolgen im Format """ & strLike & """ gefunden!"
End If
End Sub

Beliebteste Forumthreads (12 Monate)

PDF to Excel - Bestimmte Ziffernfolge suchen

Forumthread: PDF to Excel - Bestimmte Ziffernfolge suchen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread