Mit VBA Spalten auf doppelte Werte prüfen ...

Forumthread: Mit VBA Spalten auf doppelte Werte prüfen ...

16.06.2016 18:16:16

Max

Hallo zusammen,
ich möchte ein Excel Tabellenblatt Spaltenweise mittels VBA Code auf doppelte Werte überprüfen. Sobald was eingetippt wird bzw.aus einem Drop Down Menü ausgewählt wird und doppelt auftritt soll es farbig markiert werden.
Bisher habe ich es über die Bedingte Formatierung/ Doppelte Werte farbig markieren gemacht. Ist zwar ganz gut und schön und funktioniert auch nur wird es langsam unübersichtlich und einen unerklärlichen Bug gibts auch schon ....
Es gibt wohl auch eine Formelbasierte Lösung, die möchte ich aber nicht da in dem Tabellenblatt schon mehrere Formeln drin sind und ich auch nicht so recht weiß wohin damit. Außerdem gibts mehrere Benutzer die mit "copy & paste" + Enft! regelmäßig für Chaos sorgen.
So nun hab ich von VBA net wirklich Ahnung und das wenige ist aus dem iNet zusammenkopiert und solange irgendwie bearbeitet worden bis es irgendwie funktioniert ;)
Hier ist mal der VBA Code zum o.g. Problem (allerdings nicht vollständig)
Leider ist das ganze langsam und umständlich, aber es funktioniert!
Ich suche nun einen schnelleren /besseren Code, der sich auch leicht ergänzen lässt und den ich vielleicht auch nachvollziehen kann.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngCell As Range
For Each rngCell In Range("D16:D56")
If WorksheetFunction.CountIf(Range("D16:D56"), rngCell.Value) > 1 Then
rngCell.Interior.Color = RGB(240, 175, 180)     'RGB Farbwert - Flamingo1
Else: rngCell.Interior.ColorIndex = xlNone
End If
Next rngCell
For Each rngCell In Range("K16:K56")
If WorksheetFunction.CountIf(Range("K16:K56"), rngCell.Value) > 1 Then
rngCell.Interior.Color = RGB(240, 175, 180)     'RGB Farbwert - Flamingo1
Else: rngCell.Interior.ColorIndex = xlNone
End If
Next rngCell
For Each rngCell In Range("O16:O56")
If WorksheetFunction.CountIf(Range("O16:O56"), rngCell.Value) > 1 Then
rngCell.Interior.Color = RGB(240, 175, 180)     'RGB Farbwert - Flamingo1
Else: rngCell.Interior.ColorIndex = xlNone
End If
Next rngCell
For Each rngCell In Range("S16:S56")
If WorksheetFunction.CountIf(Range("S16:S56"), rngCell.Value) > 1 Then
rngCell.Interior.Color = RGB(240, 175, 180)     'RGB Farbwert - Flamingo1
Else: rngCell.Interior.ColorIndex = xlNone
End If
Next rngCell
For Each rngCell In Range("W16:W56")
If WorksheetFunction.CountIf(Range("W16:W56"), rngCell.Value) > 1 Then
rngCell.Interior.Color = RGB(240, 175, 180)     'RGB Farbwert - Flamingo1
Else: rngCell.Interior.ColorIndex = xlNone
End If
Next rngCell
For Each rngCell In Range("AA16:AA56")
If WorksheetFunction.CountIf(Range("AA16:AA56"), rngCell.Value) > 1 Then
rngCell.Interior.Color = RGB(240, 175, 180)     'RGB Farbwert - Flamingo1
Else: rngCell.Interior.ColorIndex = xlNone
End If
Next rngCell
For Each rngCell In Range("AE16:AE56")
If WorksheetFunction.CountIf(Range("AE16:AE56"), rngCell.Value) > 1 Then
rngCell.Interior.Color = RGB(240, 175, 180)     'RGB Farbwert - Flamingo1
Else: rngCell.Interior.ColorIndex = xlNone
End If
Next rngCell
For Each rngCell In Range("AI16:AI56")
If WorksheetFunction.CountIf(Range("AI16:AI56"), rngCell.Value) > 1 Then
rngCell.Interior.Color = RGB(240, 175, 180)     'RGB Farbwert - Flamingo1
Else: rngCell.Interior.ColorIndex = xlNone
End If
Next rngCell
For Each rngCell In Range("AM16:AM56")
If WorksheetFunction.CountIf(Range("AM16:AM56"), rngCell.Value) > 1 Then
rngCell.Interior.Color = RGB(240, 175, 180)     'RGB Farbwert - Flamingo1
Else: rngCell.Interior.ColorIndex = xlNone
End If
Next rngCell
For Each rngCell In Range("AQ16:AQ56")
If WorksheetFunction.CountIf(Range("AQ16:AQ56"), rngCell.Value) > 1 Then
rngCell.Interior.Color = RGB(240, 175, 180)     'RGB Farbwert - Flamingo1
Else: rngCell.Interior.ColorIndex = xlNone
End If
Next rngCell
For Each rngCell In Range("AU16:AU56")
If WorksheetFunction.CountIf(Range("AU16:AU56"), rngCell.Value) > 1 Then
rngCell.Interior.Color = RGB(240, 175, 180)     'RGB Farbwert - Flamingo1
Else: rngCell.Interior.ColorIndex = xlNone
End If
Next rngCell
If Target.Count Then
For Each rngCell In Range("K16:AU56")
Select Case rngCell.Value
Case "12"
rngCell.Interior.Color = RGB(186, 219, 244)     'RGB Farbwert - Wolkenblau
End Select
Next rngCell
End If
End Sub

Danke für Eure Hilfe

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Mit VBA Spalten ...

16.06.2016 18:36:40

Fennek
AW: Mit VBA Spalten ...

16.06.2016 19:04:42

Max

AW: Mit VBA Spalten ...

16.06.2016 18:36:40

Fennek

Hallo,
ehrlich gesagt, ich habe nur den ersten Satz gelesen, aber vielleicht passt es trotzdem:


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If WorksheetFunction.CountIf(Columns(Target.Column), Target.Value) > 1 Then MsgBox "doppelt"
'oder wenn es Farbe sein muss
If WorksheetFunction.CountIf(Columns(Target.Column), Target.Value) > 1 Then Target.Interior. _
Color = vbYellow
End Sub

mfg

AW: Mit VBA Spalten ...

16.06.2016 19:04:42

Max

Hallo Fennek,
also erstmal herzlichen Dank!
Dein Code funzt und ist auch schön kurz ;)
aber Du hättest doch bis zum Ende lesen sollen ...
was noch fehlt ist der Schnippsel ...
If Target.Count Then
For Each rngCell In Range("K16:AU56")
Select Case rngCell.Value
Case "12"
rngCell.Interior.Color = RGB(186, 219, 244) 'RGB Farbwert - Wolkenblau
End Select
Next rngCell
End If
Soll heißen der Wert 12 ist immer doppelt vorhanden und soll deshalb auch ne andere Farbe haben
Interior.Color = RGB(186, 219, 244) 'RGB Farbwert - Wolkenblau
außerdem soll jegliche Farbe wieder verschwinden wenn die Zellen leer sind oder die doppelten Werte wieder gelöscht werden.
Danke

Infobox / Tutorial

Spalten auf doppelte Werte mit VBA prüfen

Schritt-für-Schritt-Anleitung
Häufige Fehler und Lösungen
Alternative Methoden
Praktische Beispiele
Tipps für Profis
FAQ: Häufige Fragen

Schritt-für-Schritt-Anleitung

Um eine Excel-Spalte auf doppelte Werte zu prüfen und diese farblich zu markieren, kannst du den folgenden VBA-Code verwenden. Dieser Code überprüft die Spalten D, K, O, S, W, AA, AE, AI, AM, AQ und AU im Bereich von Zeile 16 bis 56.

Öffne Excel und drücke ALT + F11, um den VBA-Editor zu starten.
Wähle das entsprechende Arbeitsblatt aus, in dem du die Prüfung durchführen möchtest.
Füge den folgenden Code in das Codefenster ein:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngCell As Range
    If Target.Count > 1 Then Exit Sub

    For Each rngCell In Range("D16:D56, K16:K56, O16:O56, S16:S56, W16:W56, AA16:AA56, AE16:AE56, AI16:AI56, AM16:AM56, AQ16:AQ56, AU16:AU56")
        If WorksheetFunction.CountIf(Range(rngCell.EntireColumn), rngCell.Value) > 1 Then
            rngCell.Interior.Color = RGB(240, 175, 180) ' Farbwert für doppelte Werte
        Else
            rngCell.Interior.ColorIndex = xlNone
        End If
    Next rngCell

    If Target.Value = "12" Then
        Target.Interior.Color = RGB(186, 219, 244) ' Farbwert für speziellen Wert
    End If
End Sub

Schließe den VBA-Editor und teste die Funktion, indem du doppelte Werte in den angegebenen Spalten eingibst.

Häufige Fehler und Lösungen

Fehler beim Ausführen des Codes: Stelle sicher, dass du den Code im richtigen Arbeitsblatt-Modul eingefügt hast. Der Code muss im Modul des Arbeitsblatts sein, wo die Prüfung stattfinden soll.
Farbe wird nicht entfernt: Wenn die Zellen leer sind, wird die Farbe nicht automatisch entfernt. Du kannst den Code anpassen, um dies zu berücksichtigen, indem du eine zusätzliche Bedingung hinzufügst.
Langsame Ausführung: Bei großen Datenmengen kann der Code langsam sein. Überlege, ob du den Bereich der zu prüfenden Zellen einschränken kannst.

Alternative Methoden

Eine alternative Methode zur Prüfung auf doppelte Werte in Excel ist die Verwendung der bedingten Formatierung. Hier kannst du eine Regel erstellen, die doppelte Werte farblich markiert, ohne VBA zu verwenden. Um dies zu tun:

Wähle die Spalte aus, die du prüfen möchtest.
Gehe zu Start -> Bedingte Formatierung -> Regel erstellen.
Wähle "Formel zur Ermittlung der zu formatierenden Zellen verwenden" und gib die Formel ein:
```
=ZÄHLENWENN($D$16:$D$56;D16)>1
```
Wähle eine Formatierung aus und klicke auf "OK".

Praktische Beispiele

Hier sind einige praktische Beispiele zur Anwendung des VBA-Codes:

Beispiel 1: Du hast in Spalte D die Werte 1, 2, 2, 3, 4 eingegeben. Die Zelle mit dem Wert 2 wird rot markiert, da sie doppelt vorkommt.
Beispiel 2: Wenn du in Spalte K den Wert "12" eingibst, wird die Zelle farblich in wolkenblau markiert, solange dieser Wert vorhanden ist.

Tipps für Profis

Optimierung des Codes: Du kannst die Schleifen für die verschiedenen Spalten in eine einzige Schleife zusammenfassen, um die Lesbarkeit und Effizienz zu erhöhen.
Verwendung von Arrays: Wenn du viele Spalten hast, überlege, die Spaltennamen in ein Array zu speichern und die Schleife basierend auf diesem Array auszuführen.
Debugging: Nutze die Debugging-Tools im VBA-Editor, um Fehler im Code schnell zu finden und zu beheben.

FAQ: Häufige Fragen

1. Frage
Wie kann ich den Code so anpassen, dass er auch zwei Spalten auf Duplikate prüft?
Antwort: Du kannst den Bereich in der Schleife erweitern, um mehrere Spalten einzubeziehen. Zum Beispiel:

For Each rngCell In Range("D16:D56, K16:K56")

2. Frage
Funktioniert dieser Code in Excel 2016 und neueren Versionen?
Antwort: Ja, der Code ist mit Excel 2016 und neueren Versionen kompatibel. Stelle sicher, dass du die Makros aktiviert hast.

Beliebteste Forumthreads (12 Monate)

Mit VBA Spalten auf doppelte Werte prüfen ...

Forumthread: Mit VBA Spalten auf doppelte Werte prüfen ...

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Infobox / Tutorial

Spalten auf doppelte Werte mit VBA prüfen

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread