bestimmter Inhalt einer Zelle kopieren

Guten Morgen zusammen,
ich brauch mal eure Hilfe.
Ich habe aus dem System meiner Firma einen Report gezogen um Mitarbeiter mit
Aufträgen zu beauftragen. Um diese Mitarbeiter die richtigen Beauftragungen zu kommen zu lassen benötige ich die PLZ.
Jetzt ist es aber bei einigen Datensätzen so das ich im Report die PLZ nicht in
einer seperaten Spalte steht sondern in einem Freitext.
In diesen Freitext steht: bla bla bla wohnhaft in Musterstraße PLZ(z.B.12345) Musterstadt bla bla bla
Wie kann ich aus diesem Freitext mir nur die PLZ(z.B.12345) in eine andere Spalte kopieren. Der Freitext steht z.B. in Spalte AA12 und die PLZ soll in Spalte K12 kopiert werden.
Danke für Tip und Ideen
Gruß Danilo

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub PLZ_finden() Dim zz&, ii%, jj%, tt As String * 1, gefund As Boolean For zz = 12 To 12 ' Zeilen 12 bis 12 gefund = True For ii = 1 To Len(Cells(zz, 27)) - 4 tt = Mid(Cells(zz, 27), ii, 1) If tt >= "0" And tt <= "9" Then For jj = 1 To 4 tt = Mid(Cells(zz, 27), ii, 1) If tt < "0" Or tt > "9" Then gefund = False ii = ii + jj - 1 Exit For End If If Not gefund Then Exit For Next jj If gefund Then If Not IsEmpty(Cells(zz, 11)) Then MsgBox "In Zelle " _ & Cells(zz, 27).Address(RowAbsolute:=False, ColumnAbsolute:=False) _ & " kommt mehr als eine fünfstellige Zahl vor:" _ & Chr(13) & Chr(13) & Cells(zz, 11) & " ist gespeichert, " _ & Chr(13) & Mid(Cells(zz, 27), ii, 5) & " wurde noch gefunden" Else Cells(zz, 11).Value = Mid(Cells(zz, 27), ii, 5) End If ii = ii + 4 End If End If Next ii Next zz End Sub

Hallo Danilo,
meine zweite Version war schon etwas besser, aber auch noch nicht richtig.
Mit deiner Beispielmappe habe ich mal gestestet, da klappt es jetzt mit

Sub PLZ_finden()
Dim zz&, ii%, jj%, tt As String * 1, gefund As Boolean
For zz = 2 To 17                                        ' Zeilen 2 bis 17
For ii = 1 To Len(Cells(zz, 27)) - 4
gefund = True
tt = Mid(Cells(zz, 27), ii, 1)
If tt >= "0" And tt <= "9" Then
For jj = 1 To 4
tt = Mid(Cells(zz, 27), ii + jj, 1)
If tt < "0" Or tt > "9" Then
gefund = False
ii = ii + jj - 1
Exit For
End If
Next jj
If gefund Then
If Not IsEmpty(Cells(zz, 11)) Then
MsgBox "In Zelle " _
& Cells(zz, 27).Address(RowAbsolute:=False, ColumnAbsolute:=False) _
& " kommt mehr als eine fünfstellige Zahl vor:" _
& Chr(13) & Chr(13) & Cells(zz, 11).Text & "  ist gespeichert, " _
& Chr(13) & Mid(Cells(zz, 27).Text, ii, 5) & "  wurde noch gefunden"
Else
Cells(zz, 11).Value = Mid(Cells(zz, 27), ii, 5)
End If
ii = ii + 4
End If
End If
Next ii
Next zz
End Sub

Grüße aus Kamp-Lintfort
Erich

Option Explicit Sub PLZ_finden() Dim zz&, ii%, jj%, tt As String * 1, gefund As Boolean For zz = 12 To 12 ' Zeilen 12 bis 12 gefund = True For ii = 1 To Len(Cells(zz, 27)) - 4 tt = Mid(Cells(zz, 27), ii, 1) If tt >= "0" And tt <= "9" Then For jj = 1 To 4 tt = Mid(Cells(zz, 27), ii + jj, 1) If tt < "0" Or tt > "9" Then gefund = False ii = ii + jj - 1 Exit For End If Next jj If gefund Then If Not IsEmpty(Cells(zz, 11)) Then MsgBox "In Zelle " _ & Cells(zz, 27).Address(RowAbsolute:=False, ColumnAbsolute:=False) _ & " kommt mehr als eine fünfstellige Zahl vor:" _ & Chr(13) & Chr(13) & Cells(zz, 11).Text & " ist gespeichert, " _ & Chr(13) & Mid(Cells(zz, 27).Text, ii, 5) & " wurde noch gefunden" Else Cells(zz, 11).Value = Mid(Cells(zz, 27), ii, 5) End If ii = ii + 4 End If End If Next ii Next zz End Sub

Beliebteste Forumthreads (12 Monate)

bestimmter Inhalt einer Zelle kopieren

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

314 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

bestimmter Inhalt einer Zelle kopieren

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

314 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread