Anzeige
Archiv - Navigation
496to500
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
496to500
496to500
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Doppelte Einträge ausschließen

Doppelte Einträge ausschließen
10.10.2004 19:09:14
Hans
Hallo,
ich habe per Makrorecorder folgende Aktion aufgenommen: Es werden die Inhalte der Zellen A1 bis A5 quasi als Protokoll in Tabellenblatt 2 übernommen, wenn der Button gedrückt wird. Wie kann ich sicherstellen, dass die Inhalte der Zellen nur dann übertragen werden, wenn die Inhalte noch nicht im Tabellenblatt 2 vorhanden sind. Also es sollen keine doppelten Einträge in Tabellenblatt 2 erscheinen.
Vielen Dank für Anregungen!

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Doppelte Einträge ausschließen
PeterW
Hallo Hans,
wie sieht denn dein Code bislang aus?
Gruß
Peter
AW: Doppelte Einträge ausschließen
ransi
hallo hans
wie peter schon sagte, ohne deinen code zu kennen ist sowas schwierig zu beantworten.
aber wenn du die zellen A1 bis A5 einzeln überträgst, könntest du vorher mit Countif()
prüfen ob der zelleninhalt der zelle die grad übertragen werden soll , schon im tabellenblatt2 vorhanden ist.
wenn nein übertragen, wenn ja nimm die nächste zelle.
ransi
AW: Doppelte Einträge ausschließen
10.10.2004 21:46:28
Hans
Hallo,
hier der bisherige Code:
Tabelle1.Cells(5, 42).Value = Environ("USERNAME")
Range("AB5:AP5").Select
Selection.Copy
Sheets("Tabelle2").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown
Sheets("Tabelle1").Select
MsgBox ("Übertragung erfolgreich!")
Anzeige
AW: Doppelte Einträge ausschließen
PeterW
Hallo Hans,
hmm, was hat denn der Code damit zu tun, dass A1 bis A5 protokolliert werden sollen? Nehmen wir deinen Code als neue Grundlage der Fragestellung müsste noch geklärt werden, ob alle Zellen im Bereich AB5:AP5 mit B2:Px auf Doppelungen überprüft werden müssen oder ob es in jedem zu übertragenden Datensatz eine Zelle mit eindeutiger Zuordnung gibt.
Gruß
Peter
AW: Doppelte Einträge ausschließen
11.10.2004 07:58:59
Hans
Hallo Peter,
meine verbale Beschreibung war nur ein Beispiel. In Anlehnung an dieses habe ich hier den von mir bisher aufgezeichneten Code:
Range("A1:D1").Select
Selection.Copy
Sheets("Tabelle2").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Ich möchte eigentlich nur gewährleisten, dass die Einträge, welche in den Zellen A1 bis D1 getätigt werden und dann in Tabellenblatt 2 übertragen werden nicht schon dort vorhanden sind.
Gruß Hans
Anzeige
AW: Doppelte Einträge ausschließen
PeterW
Hallo Hans,
hmm, schon wieder andere Bedingungen. ;-)
Probier es mal so:

Sub Testlauf()
With Sheets("Tabelle2")
If WorksheetFunction.CountIf(.Columns(2), Range("A1")) And _
WorksheetFunction.CountIf(.Columns(3), Range("B1")) And _
WorksheetFunction.CountIf(.Columns(4), Range("C1")) And _
WorksheetFunction.CountIf(.Columns(5), Range("D1")) Then
MsgBox "schon da"
Exit Sub
End If
Range("A1:D1").Copy
.Range("B1").PasteSpecial Paste:=xlPasteValues
.Range("B1:E1").Insert shift:=xlDown
End With
End Sub

Gruß
Peter
AW: Doppelte Einträge ausschließen
11.10.2004 08:36:22
Hans
Vielen Dank für deinen VBA-Code. Fast genau das, was ich gesucht habe. Ziel soll es sein, eine Art Protokoll über die gemachten Einträge in den Zellen A1 bis D1 in Tabelle 1 zu generieren. Aus diesem Grund soll vor dem Eintrag immer eine leer Zeile in Tabelle 2 eingefügt werden in die dann die Einträge geschrieben werden. Wie kann ich es bewerkstelligen, dass die ganze Tabelle 2 (es werden ja immer mehr Einträge) auf Doppelungen geprüft wird.
Hier der Code (ohne die Angaben von Peter):
Sheets("Tabelle2").Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Sheets("Tabelle1").Select
Range("A1:D1").Select
Selection.Copy
Sheets("Tabelle2").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Gruß Hans
Anzeige
AW: Doppelte Einträge ausschließen
PeterW
Hallo Hans,
gib mal ein paar Beispiele, wie so ein Datensatz aussehen kann - sonst wird das hier ein Stochern im Nebel.
Gruß
Peter
AW: Doppelte Einträge ausschließen
11.10.2004 11:22:22
Hans
Hallo Peter,
hier ein Beispiel.
Nutzer 1: trägt die beigefügten Daten ein und betätigt den Button "Daten übertragen!"
Userbild
Folgender Code wird ausgeführt:
Sheets("Tabelle2").Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Sheets("Tabelle1").Select
Range("A1:D1").Select
Selection.Copy
Sheets("Tabelle2").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
In Tabelle2 stehen nun diese Angaben. Ich möchte nun gewährleisten, dass wenn genau die gleichen Werte wieder übertragen werden sollen eine Fehlermeldung erscheint.
Gruß Hans
Anzeige
AW: Doppelte Einträge ausschließen
PeterW
Hallo Hans,
der schnellste Weg der Prüfung dürfte sein, die 4 Zellen in einer zusammenzufassen und quasi als "Prüfsumme" mit in Tabelle 2 schreiben zu lassen.

Sub Test()
Dim strPruef As String
'Zellen zusammenfassen
strPruef = CStr(Range("A1") & Range("B1") & Range("C1") & Range("D1"))
With Sheets("Tabelle2")
'Platz für weitere Einträge vorhanden?
If IsEmpty(.Cells(Rows.Count, 6)) Then
'prüfen, ob die "Prüfsumme" schon vorhanden ist in Spalte F
If WorksheetFunction.CountIf(.Columns(6), strPruef) > 0 Then
'Meldung
MsgBox "schon da"
'Code verlassen
Exit Sub
End If
'Quellbereich kopieren
Range("A1:D1").Copy
'und in Tabelle 2 eintragen
.Range("B1").PasteSpecial Paste:=xlPasteValues
'Prüfsumme schreiben
.Range("F1") = CStr(.Range("B1") & .Range("C1") & .Range("D1") & .Range("E1"))
'Zellen einfügen, nach unten verschieben
.Range("B1:F1").Insert shift:=xlDown
Else
MsgBox "Tabelle ist voll!"
End If
End With
End Sub

Gruß
Peter
Anzeige
AW: Doppelte Einträge ausschließen
11.10.2004 12:43:33
Hans
Vielen Dank für den Code. Hätte ich nie hinbekommen. Ich habe diesen auf meine konkrete Anwendung angepasst.

Sub Makro2()
Dim strPruef As String
'Zellen zusammenfassen
strPruef = CStr(Range("AB5") & Range("AC5") & Range("AD5") & Range("AE5") & Range("AF5") & Range("AG5") & Range("AH5") & Range("AI5") & Range("AJ5") & Range("AK5") & Range("AL5") & Range("AM5") & Range("AN5") & Range("AO5") & Range("AP5"))
With Sheets("tabelle2")
'Platz für weitere Einträge vorhanden?
If IsEmpty(.Cells(Rows.Count, 17)) Then
'prüfen, ob die "Prüfsumme" schon vorhanden ist
If WorksheetFunction.CountIf(.Columns(17), strPruef) > 0 Then
'Meldung
MsgBox "Eintrag existiert bereits. Bitte überprüfen Sie die Eingaben!"
'Code verlassen
Exit Sub
End If
'Quellbereich kopieren
Range("AB5:AP5").Copy
'und in Tabelle 2 eintragen
.Range("B2").PasteSpecial Paste:=xlPasteValues
'Prüfsumme schreiben
.Range("Q1") = CStr(.Range("B2") & .Range("C2") & .Range("D2") & .Range("E2") & .Range("F2") & .Range("G2") & .Range("H2") & .Range("I2") & .Range("J2") & .Range("K2") & .Range("L2") & .Range("M2") & .Range("N2") & .Range("O2") & .Range("P2"))
'Zellen einfügen, nach unten verschieben
.Range("B2:P2").Insert Shift:=xlDown
Else
MsgBox "Tabelle ist voll!"
End If
End With
End Sub

Bei mir werden die Zellen AB5 bis AP5 in die Tabelle "tabelle2" übertragen. Mir ist aufgefallen: Wenn man in AB5 einen wert eingibt und die restlichen Zellen leer läßt, wird dieser übertragen (ist ja auch ok). Versucht man das gleich noch einmal kommt die Fehlermeldung (auch ok). Trägt man aber etwas anderes ein und danach den zuvor genutzten Wert, erscheint keine Fehlermeldung obwohl der Wert schon in der Tabelle 2 vorhanden ist. Die Prüfung auf Doppelungen müsste also auf den gesamten Bereich der Tabelle 2 erfolgen. Ich hoffe du konntest mir folgen.
gruß
Anzeige
AW: Doppelte Einträge ausschließen
PeterW
Hallo Hans,
da sind dir beim Anpassen zwei Fehler unterlaufen (und mir eine Vereinfachung durch die Lappen gegangen). Ändere
'Prüfsumme schreiben
.Range("Q1") = CStr(.Range("B2") & .Range(".....
in
.Range("Q2")= strPruef
sowie
'Zellen einfügen nach unten verschieben
.Range("B2:P2").Insert Shift:=xlDown
in
.Range("B2:Q2").Insert....
Gruß
Peter
AW: Doppelte Einträge ausschließen
11.10.2004 14:01:35
Hans
Vielen Vielen Dank. Klappt alles super.
AW: Doppelte Einträge ausschließen
11.10.2004 08:10:27
Hans
Hallo Peter,
meine verbale Beschreibung war nur ein Beispiel. In Anlehnung an dieses habe ich hier den von mir bisher aufgezeichneten Code:
Range("A1:D1").Select
Selection.Copy
Sheets("Tabelle2").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Ich möchte eigentlich nur gewährleisten, dass die Einträge, welche in den Zellen A1 bis D1 getätigt werden und dann in Tabellenblatt 2 übertragen werden nicht schon dort vorhanden sind.
Gruß Hans
Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige