Sorry hatte ne Zeit lang etwas anderes zu tun. Und bin nicht dazu gekommen alles zu testen. Ich habe einen haltepunkt gesetzt aber es kam kein ergebnis. Wer möchte die Tabelle den nu zum test haben. Die Zahlen stehen an den Plätzen, den zusatztext habe ich entfernt. Deswegen gibt es nur Zahlen. So ungefähr sieht die Orginal Tabelle aus.

ich ich ich --- Mailadresse im Profil

Ich hätte jetzt aber auch mal ne Frage.

1. Was muß ich machen, das er nur die Spalte B absucht ist es wie ich es unten gemacht habe richtig

2. Wenn ich die Komplette Spalte B durchsuchen will dann schreibe ich das ja so

For i = 2 To 65536

Cells(2).Activate

dieses Verfahren dauert aber relativ lange (ca. 30 Sekunden)

wie kann ich das einstellen, das er nicht alle Zeilen durchsucht, sondern nur die, die nicht leer sind leer sind.

Quasi so wie die normale Excelsuchfunktion!

wenn du nur einen wert suchst, (normale excel suchfunktion) geht das damit:

Cells.Find(What:=wasdusuchst, After:=ActiveCell, LookIn:=xlValues, LookAt _

:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _

False).Activate

ansonsten dauern vb-schleifen nun mal eine weile, hat ja ne menge arbeit, der kleine

achso-ansonsten brauchst du die zelle nicht aktivieren, du kannst auch mit cells(x,y).value den wert auslesen, geht a bissel schneller. und wenn du vor der prozedur den bildschirm mit

application.screenupdate=false ausschaltest,flimmerts auch nicht so. aber wieder einschalten nicht vergessen

Ich hab es jetzt so gelöst:

Sub Suchen()

Dim zusuchen

Dim i%

zusuchen = InputBox("Bitte geben Sie die Nummer ein, die Sie suchen?")

With Worksheets(1).Range("b4:b65536")

Set zelle = .Find(zusuchen, lookat:=xlWhole)

If Not zelle Is Nothing Then

ersteAdresse = zelle.Address

Do

For i = 1 To 29

zelle(1, i).Interior.Pattern = xlPatternGray16 'xlPatternGray50

zelle(1, i).Interior.ColorIndex = 6

Next i

Set zelle = .FindNext(zelle)

Loop While Not zelle Is Nothing And zelle.Address <> ersteAdresse

End If

End With

End Sub

sieht gut aus

Ja da gibt es nur ein kleines Problem.

Wenn ich auf Abbrechen drücke, dann markiert er alle Felder bis 65536 und hängt sich auf wie kann ich das lösen, das er dann einfach Abbricht?