Zwei Spalten afu doppelte Einträge überprüfen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Speichern_Click() 'Die aktualisierte Zeile 1 aus Tabelle1 wird als neue Zeile 'an die Tabelle Daten angefügt! Dim letzteZeile As Integer letzteZeile = ActiveCell.Row + 1 ThisWorkbook.Sheets("Daten").Cells(letzteZeile, 1) = 1.Value ThisWorkbook.Sheets("Daten").Cells(letzteZeile, 2) = 2.Value ThisWorkbook.Sheets("Daten").Cells(letzteZeile, 3) = 3.Value ThisWorkbook.Sheets("Daten").Cells(letzteZeile, 4) = 4.Value ThisWorkbook.Sheets("Daten").Cells(letzteZeile, 5) = 5.Value ThisWorkbook.Sheets("Daten").Cells(letzteZeile, 6) = 6.Value ThisWorkbook.Sheets("Daten").Cells(letzteZeile, 7) = 7.Value ThisWorkbook.Sheets("Daten").Cells(letzteZeile, 8) = 8.Value ThisWorkbook.Sheets("Daten").Cells(letzteZeile, 9) = 9.Value Calculate 'Es wird geprüft ob eine doppelte Eingabe mit gleichem Mitarbeiter/Monat 'vorhanden ist. Wenn ja, dann wird eine Mitteilung geöfnet deren Bestätigung 'das UserForm2 aufruft. i = 2 Do While Worksheets("Daten").Cells(i, "A") <> "" i = i + 1 Loop For j = 1 To i For k = (1 + j) To i If (Worksheets("Daten").Cells(j, "A") = Worksheets("Daten").Cells(k, "A") And _ Worksheets("Daten").Cells(j, "B") = Worksheets("Daten").Cells(k, "B")) Then MsgBox ("Doppelte Eingabe") Load UserForm2 UserForm2.Show End If Next Next End Sub

Private Sub Überschreiben_Click() Dim Zeile As Integer Zeile = ActiveCell.Row Worksheets("Daten").Cells(Zeile, 1).Clear Worksheets("Daten").Cells(Zeile, 2).Clear Worksheets("Daten").Cells(Zeile, 3).Clear Worksheets("Daten").Cells(Zeile, 4).Clear Worksheets("Daten").Cells(Zeile, 5).Clear Worksheets("Daten").Cells(Zeile, 6).Clear Worksheets("Daten").Cells(Zeile, 7).Clear Worksheets("Daten").Cells(Zeile, 8).Clear Worksheets("Daten").Cells(Zeile, 9).Clear UserForm2.Hide End Sub

Private Sub CommandButton3_Click() i = 2 Do While Worksheets("Tabelle1").Cells(i, "A") <> "" i = i + 1 Loop For j = 1 To i For k = (1 + j) To i If (Worksheets("Tabelle1").Cells(j, "A") = Worksheets("Tabelle1").Cells(k, "A") And _ Worksheets("Tabelle1").Cells(j, "B") = Worksheets("Tabelle1").Cells(k, "B")) Then Antwort = MsgBox(("Neueintrag"), 3) Select Case Antwort Case Is = 6 'ja 'Neueintrag z = 1 Do While Cells(z, 1) <> "" z = z + 1 Loop Cells(z, 1) = Me.TextBox1 Cells(z, 2) = Me.TextBox2 Case Is = 7 'nein Änderung Cells(j, 1) = TextBox1.Value Cells(j, 2) = TextBox2.Value Case Is = 2 'Abbruch Exit Sub End Select End If Next Next End Sub

Na dem Ziel komme ich schon ein wenig näher... allerdings löscht er mir jetzt nur die doppelte, aber nicht auch die ursprüngliche Zeile.


Private Sub Speichern_Click()
'Die aktualisierte Zeile 1 aus Tabelle1 wird als neue Zeile
'an die Tabelle Daten angefügt!
Dim letzteZeile As Integer
Dim Zeile As Integer
letzteZeile = ActiveCell.Row + 1
ThisWorkbook.Sheets("Daten").Cells(letzteZeile, 1) = 1.Value
ThisWorkbook.Sheets("Daten").Cells(letzteZeile, 2) = 2.Value
ThisWorkbook.Sheets("Daten").Cells(letzteZeile, 3) = 3.Value
ThisWorkbook.Sheets("Daten").Cells(letzteZeile, 4) = 4.Value
ThisWorkbook.Sheets("Daten").Cells(letzteZeile, 5) = 5.Value
ThisWorkbook.Sheets("Daten").Cells(letzteZeile, 6) = 6.Value
ThisWorkbook.Sheets("Daten").Cells(letzteZeile, 7) = 7.Value
ThisWorkbook.Sheets("Daten").Cells(letzteZeile, 8) = 8.Value
ThisWorkbook.Sheets("Daten").Cells(letzteZeile, 9) = 9.Value
Calculate
'Es wird geprüft ob eine doppelte Eingabe mit gleichem Mitarbeiter/Monat
'vorhanden ist. Wenn ja, dann wird eine Mitteilung geöfnet deren Bestätigung
'alle doppelten, also auch die ursprügnliche, löschen soll. Der Anwender
'muß den Datensatz erneut eingeben.
I = 2
Do While Worksheets("Daten").Cells(I, "A") <> ""
I = I + 1
Loop
For j = 1 To I
For k = (1 + j) To I
X = (Worksheets("Tabelle1").Cells(Zeile, 1))
y = (Worksheets("Tabelle1").Cells(Zeile, 2))
If (Worksheets("Daten").Cells(j, "A") = Worksheets("Daten").Cells(k, "A") = X And _
Worksheets("Daten").Cells(j, "B") = Worksheets("Daten").Cells(k, "B")) = y Then
Antwort = MsgBox("Doppelte Eingabe! Bitte wiederholen Sie die Eingabe.")
Select Case Antwort
Case Is = 6 'OK bewirkt das Löschen der doppelten Datensätze
End Select
End If
Next
Next
'Löschen der doppelten und der ursprüngloichen Zeilen; das erfordert die Neueingabe des Datensatzes!
'Lösche alle Zeilen in denen
'Spalte A wie Feld Tabelle1/A2(X) und Spalte B wie Feld Tabelle/B2(Y)
Dim InI As Long
Dim LoLetzte As Long
LoLetzte = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row, 65536)
For InI = LoLetzte To 2 Step -1
If Cells(InI, 1) = Cells(InI - 1, 1) And Cells(InI, 2) = Cells(InI - 1, 2) Then Rows(InI).Delete
Next
End Sub

Wenn ich jetzt die Zeile "If Cells(InI, 1) = Cells(InI - 1, 1) And Cells(InI, 2) = Cells(InI - 1, 2) Then Rows(InI).Delete" abändere in "If Cells(InI, 1) = Cells(InI - 1, 1) And Cells(InI, 2) = Cells(InI - 1, 2) and Cells(InI, 1) = x and Cells(InI, 2) = y Then Rows(InI).Delete" müßte ich doch nur noch x und y als Tabelle1, Zeile 1, Spalte a bzw b definieren (in Zeile 1 der Tabelle1 wird der aktuelle Datensatz geschrieben damit man beim Betätigen der Schaltfläche grau hinterlegte Felder die sich aus den Eingaben berechnen angezeigt bekommt)... Nur wenn ich das mache dann löscht er mir immer alle Einträge...?
Aber bestimmt gibt es eine weit weniger komplizierte Methode die doppelten Zeilen, auch die ursprünglichen, zu löschen...
Vielen Dank für Hilfe.
Gruß Klaus

Wo bzw wie finde ich die? Habe ja 8 Jahre nichts programmiert; und wieviel kann man in drei Wochen gelernt haben?
Aber ein anderer Ansatz kann eventuell einfacher sein.
Ich gebe Werte in eine Userform ein. Diese werden in der Tabelle1 immer in die Zeile 1 Geschreiben und durch den Schalter werden graue Felder in der Eingabemaske mit Werten gefüllt. Danach kann ich durch die Daten aus der Tabelle1 in die Tabelle Daten schreiben; und zwar immer als neue Zeile.
Wenn ein Datensatz mit zwei Eigenschaften (Listenfeld 1 und Listenfeld 2; Name und Monat) nach dem Berechnen und vor dem Speichern schon in der Tabelle Daten stehen, dann soll er einfach ohne Meldung den ursprünglichen Datensatz in der Tabelle Daten überschreiben.
Allerdings vereinfacht das die Sache an sich auch nicht unbedingt. Außer das eben eine Abfrage wegfällt die professionell mindestens zwei Möglichkeiten haben müßte.
1. Neue Daten übernehmen
2. Alete Daten belassen und neuen löschen´
Egal was ich bisher auch immer probiert habe; ich schaffe es lediglich den gerade aktuellen Datensatz zu löschen...

Beliebteste Forumthreads (12 Monate)

Zwei Spalten afu doppelte Einträge überprüfen

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zwei Spalten afu doppelte Einträge überprüfen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread