AW: Beim Schneeschaufeln ? ;-)
26.02.2006 12:41:24
Volker
Hallo Rainer,
Du hast Recht, die Grundzüge funktionieren ja auch, aber ich habe festgestellt das der Code
in der Anwendung doch etwas unzweckmäßig ist.
Ich habe versucht die Einzelschritte dahingehend zu ändern, das die gesamte erste Tabelle
Zelle für Zelle in der Arbeitsmappe nach doppelten sucht, dann die gefundenen doppelten löscht.
Momentan sieht es ja so aus das bei jedem Zelleintrag der event. Doppelte angezeigt und
gelöscht wird
Sub Doppelte_suchen(z As Integer, s As Integer)
Dim ws As Worksheet, wsNameA As String
Dim Lz As Integer, i As Integer
Dim Eingabe As String, Aktiv As Object
Dim Weiter
Set Aktiv = ThisWorkbook.ActiveSheet
wsNameA = ThisWorkbook.ActiveSheet.Name
Eingabe = ThisWorkbook.ActiveSheet.Cells(z, s)
For Each ws In ActiveWorkbook.Worksheets
Lz = ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To Lz
If Eingabe <> "" Then
If ws.Cells(i, 1) = Eingabe Then
If ws.Name <> wsNameA Then
If MsgBox("Achtung, Eintrag bereits in " & ws.Name & _
" vorhanden. Eintrag löschen ?", vbYesNo) = vbYes Then
'With Aktiv
'.Range(.Cells(z, 1), .Cells(z, 5)).ClearContents
'End With
ws.Select
ws.Cells(i, 1).Select
'.Range(.Cells(z, 1), .Cells(z, 5)).ClearContents
Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(ActiveCell.Row, ActiveCell.Column + 4)).ClearContents
Sheets("Tabelle1").Select
Range("A1").Select
Exit Sub
End If
End If
End If
End If
Next i
Next ws
Lz = Aktiv.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To Lz - 1
If Aktiv.Cells(i, 1) = Eingabe Then
Weiter = MsgBox("Achtung, Eintrag bereits in aktiver Tabelle vorhanden. Wollen Sie dies zulassen?", _
vbYesNo)
If Weiter = vbNo Then
Aktiv.Cells(z, 1) = ""
Aktiv.Cells(z, 1).Select
Exit Sub
End If
End If
Next i
End Sub
Wie kann man den Code nach meinen Wünschen ändern?
Danke Gruß Volker