ist Zelle nicht leer -> überspringen @ Erich G.
06.07.2005 12:20:52
Danilo
ich habe gestern zu folgendem Thema: bestimmter Inhalt einer Zelle kopieren einen Code bekommen, danke nochmal dafür an Erich G.
Jetzt habe ich aber feststellen müssen das auch in Zellen die bereits einen Wert
enthalten nicht übersprungen werden was aber sein sollte da die Werte schon korrekt sind.
Dieser Code sucht in Spalte 27 nach einer 5stelligen Zahl und kopiert diese dann in die Zelle in Spalte J.
Wenn aber in der Zelle der Spalte J schon erwas steht, soll nichts kopiert werden.
Danke für eure Hilfe
Sub PLZ_finden_im_Freitext_und_kopieren()
Dim zz&, ii%, jj%, tt As String * 1, gefund As Boolean
For zz = Cells(Rows.Count, 27).End(xlUp).Row To 2 Step -1 '2 To 100
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
If Not gefund Then Exit For
Next jj
If gefund Then
If Not IsEmpty(Cells(zz, 10)) 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, 10).Text & " ist gespeichert, " _
& Chr(13) & Mid(Cells(zz, 27).Text, ii, 5) & " wurde noch gefunden"
Else
Cells(zz, 10).Value = Mid(Cells(zz, 27), ii, 5)
End If
ii = ii + 4
End If
End If
Next ii
Next zz
End Sub
Anzeige