Doppelten Werte in Spalte bestätigen

Hallo zusammen,

ich bin neu hier im Forum und komme auch schon mit einem Problem und hoffe ihr könnt mir etwas helfen.
Ich bin nur am Rande mit VBA vertraut, Schleifen und if-Abfragen bekomme ich hin, aber mein aktuelles Problem erfordert (glaube ich) das Speichern von Zuständen.

In meiner Tabelle gibt es pro Woche eine Spalte in die verschiedene Kürzel eingetragen werden können. Wenn ich jetzt in einer Spalte in zwei verschiedenen Zellen das gleiche Kürzel eintrage, dann hätte ich gern ein Bestätigungsfenster mit einer "Ja" oder "Nein" Auswahl. Wenn ich auf "Ja" klicke, dann soll dieses doppelte Wertepaar so akzeptiert werden. Wenn "Nein" dann wird der Zelleninhalt der zuletzt beschriebenen Zelle wieder gelöscht. Sollte ich auf "Ja" geklickt haben und gebe in einer anderen Zelle, aber immer noch in der gleichen Spalte, wieder das gleiche Kürzel ein, dann soll wieder nach gefragt werden.
Das ganze sollte immer automatisch für die aktive Spalte ausgeführt werden.

Im Netz finde ich viele Beispiele, wie ein Code ausgeführt wird, wenn sich etwas im Tabellenblatt ändert und ich finde viele Beispiele für das Suchen von doppelten Werten in einer Spalte.

Mir fehlt ein Lösungsansatz, wie ich mir die Wertepaare, die ich mit "Ja" bestätigt habe merken kann und diese dann nicht mehr auf mehrfaches Vorkommen geprüft werden, auch nicht wenn man Excel schließt und wieder öffnet.

Könnt ihr mir da bitte weiter helfen?

Ich danke euch schon mal für eure Zeit!

Viele Grüße

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Spalte As Integer, erste_Zeile As Integer, letzte_Zeile As Long, laufende_zelle As Integer, doppelter_wert As String, found As Object, last_row As Integer erste_Zeile = 1 letzte_Zeile = 250 Spalte = 1 If Not Application.Intersect(Target, Range("A1:A10")) Is Nothing Then For laufende_zelle = letzte_Zeile To erste_Zeile Step -1 If WorksheetFunction.CountIf(Range(Cells(erste_Zeile, Spalte), Cells(letzte_Zeile, Spalte)), Cells(laufende_zelle, Spalte)) > 1 Then doppelter_wert = Cells(laufende_zelle, Spalte).Value Set found = Sheets("Tabelle2").Columns(Spalte).Find(doppelter_wert, LookIn:=xlValues, LookAt:=xlWhole) If found Is Nothing Then If MsgBox("Du hast " + doppelter_wert + " diese Woche schon eingeplant, ist das korrekt so?", vbYesNo) = vbYes Then last_row = Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row Sheets("Tabelle2").Cells(last_row + 1, Spalte).Value = doppelter_wert Else Sheets("Tabelle").Cells(ActiveCell.Row - 1, Spalte).Value = "" End If End If End If Next laufende_zelle End If End Sub

Hallo

dein Code zeugt von deinem Versuch mit hochmodernen Excel Befehlen ein tolles Programm zu schreiben. Alle Achtung.
Meine alte Methode aus der Zeit Excel 95/97 ist ein amüsanter Oldtimer, dürfte aber zuverlässig laufen.

Statt ZählenWenn Methode lade ich mir alle Werte in ein Textfeld um auf eine beliebige Spalte doppelte zu prüfen.
Mein Makro funktioniert in jeder Spalte, du hast dein Makro nur auf Spalte 1 gesetzt! Das Target Makro gehört ins aktive Blatt.
Das zweite Makro prüft die gesamte Tabelle, alle Spalten, auf doppelte Einträge. Das gehört in ein normles Modul!
Bin gespannt wie dir meine Arbeit gefällt, und ob alles Fehlerfrei funktioniert?? Sonst beheben wir die Fehler.

mfg Piet

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Spalte As Integer, letzte_Zeile As Long
 Dim AC As Range, last_row As Long, ok As Variant
 Dim Bereich As String, Wert As Variant, Txt As String
 
On Error Resume Next
 letzte_Zeile = 250      '* normal ist last_row!
 Spalte = Target.Column
 last_row = Cells(Rows.Count, Spalte).Row
 Bereich = Cells(1, Spalte).Resize(last_row, 1).Address
 Application.ScreenUpdating = False
 
If Not Intersect(Target, Range(Bereich)) Is Nothing Then
   If Target.Value = Empty Then Exit Sub
   For Each AC In Range(Bereich)
       If AC.Value > Empty And InStr(Txt, AC) Then
          Application.ScreenUpdating = True
          AC.Select  'bei doppelt Zelle doppelte anzeigen
          ok = MsgBox("Dieser Wert ist doppelt! - Bestehen lassen?", vbYesNoCancel)
          If ok = vbNo Then AC.Value = Empty
          If ok = vbCancel Then Exit Sub
       ElseIf AC.Value > Empty Then
          Txt = Txt & ", " & AC.Value
       End If
   Next AC
   Target.Offset(1, 0).Select
End If
End Sub

Option Explicit

Sub Tabelle_prüfen()
Dim Spalte As Integer, last_Spalte As Integer
Dim AC As Range, last_row As Long, ok As Variant
Dim Bereich As String, Wert As Variant, Txt As String

last_Spalte = Cells(1, Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False

For Spalte = 1 To last_Spalte: Txt = Empty
Range(Bereich).Select 'zu prüfender Range
last_row = Cells(Rows.Count, Spalte).Row
Bereich = Cells(1, Spalte).Resize(last_row, 1).Address
For Each AC In Range(Bereich)
If AC.Value > Empty And InStr(Txt, AC) Then
Application.ScreenUpdating = True
AC.Activate 'bei doppelt Zelle doppelte anzeigen
ok = MsgBox("Dieser Wert ist doppelt! - Bestehen lassen?", vbYesNoCancel)
If ok = vbNo Then AC.Value = Empty
If ok = vbCancel Then Exit Sub
ElseIf AC.Value > Empty Then
Txt = Txt & ", " & AC.Value
End If
Next AC
Next Spalte
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Spalte As Integer Dim erste_Zeile As Integer Dim letzte_Zeile As Long Dim laufende_zelle As Integer Dim doppelter_wert As String Dim found As Object Dim last_row As Integer Dim lastModifiedCell As Range Dim previousModifiedCell As Range erste_Zeile = 1 letzte_Zeile = 250 Spalte = 1 If Not Application.Intersect(Target, Range("A1:A10")) Is Nothing Then For laufende_zelle = letzte_Zeile To erste_Zeile Step -1 Set lastModifiedCell = Target If WorksheetFunction.CountIf(Range(Cells(erste_Zeile, Spalte), Cells(letzte_Zeile, Spalte)), Cells(laufende_zelle, Spalte)) > 1 Then doppelter_wert = Cells(laufende_zelle, Spalte).Value Set found = Sheets("Tabelle2").Columns(Spalte).Find(doppelter_wert, LookIn:=xlValues, LookAt:=xlWhole) If found Is Nothing Then If MsgBox("Du hast " + doppelter_wert + " diese Woche schon eingeplant, ist das korrekt so?", vbYesNo) = vbYes Then last_row = Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row Sheets("Tabelle2").Cells(last_row + 1, Spalte).Value = doppelter_wert Else MsgBox (doppelter_wert.Address - 1) End If End If End If Next laufende_zelle End If End Sub

Beliebteste Forumthreads (12 Monate)

Doppelten Werte in Spalte bestätigen

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Doppelten Werte in Spalte bestätigen

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

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread