automatische Erkennung !?

hallo zusammen, hier ist Lisa
Ich habe folgendes Problem.
Ich möchte in meinem Arbeitsblatt eine automatische Erkennung haben, die sich wie folgt gestallten soll.
Auf meinem Arbeitsblatt habe ich eine Vielzahl an Namen wobei es mir immer wieder passiert, dass diese doppelt aufgeführt werden.
Jetzt die Frage.
Wenn ich in die Celle Z15 z.B. einen Namen schreibe der in der Celle C11 steht, kann man dann diesen Namen aus der Celle C11 automatisch löschen lassen?
Noch besser wäre es wenn vorher nachgefragt werden würde. Achtung Name aus C11 löschen oder so ähnlich.
Kann man so etwas über VBA hinbekommen? Mit Formeln habe ich es versucht, das bekomme ich aber auf Grund der Datenvielfalt nicht hin.
Wer kann mir hierbei helfen?
mfG lisa

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Dim Suche As Range 'Prüfbereich einschränken If Intersect(Range("B5:D19"), Target) Is Nothing _ Or Target.Count <> 1 Then Exit Sub 'Nur bei nicht leeren Zellen prüfen If Target.Value = "" Then Exit Sub Set Suche = Range("B5:D19").Find(Target.Value) If Not Suche Is Nothing Then If MsgBox("Gleicher Eintrag in Zelle " & _ Suche.Address & " löschen?", vbYesNo) = vbYes Then Cells(Suche.Row, Suche.Column).ClearContents End If End If End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim Suche As Range 'Prüfbereich einschränken If Intersect(Range("A1:AZ1000"), Target) Is Nothing _ Or Target.Count <> 1 Then Exit Sub 'Nur bei nicht leeren Zellen prüfen If Target.Value = "" Then Exit Sub Set Suche = Range("B5:E19").Find(Target.Value) If Not Suche Is Nothing Then If MsgBox("Gleicher Eintrag in Zelle " & _ Suche.Address & " löschen?", vbYesNo) = vbYes Then Cells(Suche.Row, Suche.Column).ClearContents End If End If End Sub

Hallo Lisa,
hier gings aber schon zur Sache.
Ich habe am Code noch ein bisschen gefeilt.
Sucheingaben sind so wie der Code unten steht in den Spalten "B:E" möglich
(If Target.column ... and Target.column ... 5 then exit sub)
Dies hat den Nebeneffekt, dass gleich bei der Eingabe in "B5:D19" geprüft wird
Du kannst dies bei Bedarf leicht abändern.( Auch mit If Target.Row ....)
Die Prozedur ist so angelegt, dass alle Zellen im Bereich
Cells(5,2),Cells(19,4) = "B5:D19" abgeglichen werden, also auch mehrere gleiche
Einträge.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Suche As Range, Gef As Range, Spalte As Integer, First As String
If Target.Count > 1 Then Exit Sub     ~f~
If Target.Value = Empty Then Exit Sub
~f~    If Target.Column < 2 Or Target.Column > 5 Then Exit Sub     ~f~
Set Suche = Target
For Spalte = 2 To 4
Set Gef = Range(Cells(4, Spalte), Cells(19, Spalte)).Find(Suche)
If Not Gef Is Nothing Then
First = ""
~f~Do While Firstaddress <> Gef.Address
If Not Gef.Address = Suche.Address Then
If MsgBox("Gleichen Namen in Zelle " & Gef.Address _
& " löschen ? ", vbYesNo, Suche.Value) = vbYes Then
Gef.Value = Empty
End If
End If
First = Gef.Address
Set Gef = Range(Cells(Gef.Row, Spalte), Cells(10, Spalte)).Find(Suche)
If Gef Is Nothing Then Exit Do
Loop
End If
Next
End Sub

f und das Tildezeichen steht nur drin, damit der Code ins Forum ging!
Noch allen an diesem Thread Beteiligten ein schönes Wochenende
Gerd

Beliebteste Forumthreads (12 Monate)

29 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

29
Beiträge zum Forumthread

Beiträge zu diesem Forumthread