Zwei Spalten afu doppelte Einträge überprüfen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Zwei Spalten afu doppelte Einträge überprüfen von: Klaus
Geschrieben am: 07.02.2005 10:03:52

Hallo zusammen,

diese Seite ist eine echte Hilfe für mich; habe zwar mal 3 Wochen einen VBA-Kurs besucht aber das ist nun schon 8 Jahre her und in der Zwischenzeit habe ich garnichts programmiert.
Mein Problem ist nun das ich zwei Spalten (1.Value und 2.Value) einer Tabelle beim Versuch den letzten Eintrag der über die Userform1 mit der Funktion:

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
End Sub


angefügt wird auf doppelte Einträge überfrüfen muß und dem Anwender die Möglichkeit geben will entweder die ursprüngliche oder eben die aktuelle Zeile zu verwenden. Die Werte der aktuellen Zeile stehen noch im Userform1 und können so auf Richtigkeit vom Anwender überprüft werden. Die ursprünglichen Werten sollen nicht angezeigt werden.

Ich habe schon sehr viele Lösungsmöglichkeiten hier aus dem Forum getestest. Allerdings komme ich nicht klar damit das ich zwei Spalten abfragen muß und wie ich aus dem Userform1 bei doppelten Werten die Userform2 (enthält einen Befehlsknopf der dann die neue Zeile einfügt und einem der letztendlich nichts macht) aufrufen kann.

Mein zweites Problem ist die Userform2 nach betätigen eines Befehlsknopfes zu beenden.

Vielen Dank schon im vorraus für Hilfe.

LG Klaus
Bild


Betrifft: AW: Zwei Spalten afu doppelte Einträge überprüfen von: Klaus
Geschrieben am: 08.02.2005 16:17:10

Einen Schritt bin ich nun weiter. Allerdings ist jetzt das Problem das eben jede Zeile (Zeile 1 ist Überschrift also i = 2) geprüft wird!!!???

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


Hier noch die Userform2:

(Es fehlt mir noch das die leere Zeile dann auch gelöscht wird...):

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


Da gibt er mir als Fehlermeldung das nach der <>.Hide nur noch Kommentare kommen dürfen... ??? Aber ich benötige doch noch einen zweiten Schalter um eben die ursprüngliche Zeile beizubehalten und die neue Zeile zu löschen....

Danke für Hilfe.


Bild


Betrifft: AW: Zwei Spalten afu doppelte Einträge überprüfen von: michael
Geschrieben am: 09.02.2005 09:15:39

Hallo Klaus
Ich hbe den Code ein bißchen umgeschrieben. Vielleicht kannst Du etwas damit anfangen

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(("Doppelte Eingabe ! Was willst Du tun? Neueintrag oder Änderung"), 3)
Select Case Antwort
Case Is = 6 'Ja


Case Is = 7'Nein


Case Is = 2'Abbruch


End Select
End If
Next
Next

Gruß
Michael


Bild


Betrifft: AW: Zwei Spalten afu doppelte Einträge überprüfen von: Klaus
Geschrieben am: 09.02.2005 09:31:41

Hey, das sieht schon super professionell aus; wenn ich den Code richitg verstehe dann muß ich nur noch das löschen der ursprünglichen bzw der letzen Eingabe reinsetzen....?

Da ich jetzt leider außer Haus muß werde ich erst heute abend dazu kommen ... oder gar erst morgen vormittag...

Danke dir


Bild


Betrifft: AW: Zwei Spalten afu doppelte Einträge überprüfen von: michael
Geschrieben am: 09.02.2005 10:07:18

hallo Klaus
Ein bißchen abändern mußt du ihn schon noch. Du bekommst eine Abfrage JA/NEIN/ABBRECHEN nach jeder Bedingung Exit Sub nicht vergessen. Und die Tabellenblattbezeichnung wieder umbenennen. Den letzten Beitrag was ich Dir geschickt habe funktioniert nicht so richtig. Vielleicht kanns Du damit trotzdem was anfangen
Michael


Bild


Betrifft: AW: Zwei Spalten afu doppelte Einträge überprüfen von: michael
Geschrieben am: 09.02.2005 09:33:25

Ich habs gerade mit einer Userform probiert und das funktioniert eigentlich tadellos
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


michael


Bild


Betrifft: AW: Zwei Spalten afu doppelte Einträge überprüfen von: Klaus
Geschrieben am: 09.02.2005 16:28:40

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


Bild


Betrifft: AW: Zwei Spalten afu doppelte Einträge überprüfen von: Helmut
Geschrieben am: 12.02.2005 02:24:25

Hast du schon mal den Spezialfilter ausprobiert?

H.


Bild


Betrifft: AW: Zwei Spalten afu doppelte Einträge überprüfen von: Klaus
Geschrieben am: 12.02.2005 06:48:57

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...


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Zwei Spalten afu doppelte Einträge überprüfen"