Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

doppelte Einträge mit VBA verhindern

Betrifft: doppelte Einträge mit VBA verhindern von: Sonnenfreund
Geschrieben am: 15.09.2020 15:35:55

Hallo, ich habe schon folgendes Macro gefunden, um doppelte Eingaben in einem Bereich zu _ verhindern.

https://www.herber.de/forum/archiv/816to820/816003_doppelte_Eintraege_mit_VBA_verhindern.html#816014

Gibt es eine Möglichkeit, dies auch für Teilübereinstimmungen zu machen?

Also bspw. ist BCD vorhanden und es sollen auch Meldungen erscheinen, wenn man

1. aBCD

2. BCDe

3. aBCDe


eingibt.

Betrifft: AW: doppelte Einträge mit VBA verhindern
von: Hajo_Zi
Geschrieben am: 15.09.2020 16:01:37

If Intersect( Target"BCD")>1 then

End if

GrußformelHomepage

Betrifft: AW: doppelte Einträge mit VBA verhindern
von: Nepumuk
Geschrieben am: 15.09.2020 16:05:39

Hallo Sonnenfreund,

in das Modul der Tabelle (Rechtsklick auf den Tabellenreiter - Code anzeigen):

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim avntValues As Variant
    Dim ialngIdex As Long
    Dim objRang As Range, objCell As Range
    Set objRang = Intersect(Target, Columns(1))
    If Not objRang Is Nothing Then
        Application.EnableEvents = False
        avntValues = Range(Cells(1, 1), Cells(Rows.Count, 1)).Value
        For Each objCell In objRang
            For ialngIdex = LBound(avntValues, 1) To UBound(avntValues, 1)
                If ialngIdex <> objCell.Row Then
                    If InStr(1, objCell.Value, avntValues(ialngIdex, 1), vbTextCompare) > 0 Or _
                        InStr(1, avntValues(ialngIdex, 1), objCell.Value, vbTextCompare) > 0 Then
                        Call MsgBox("Doppelter Wert in Zelle ''" & _
                            objCell.Address(False, False) & "''", vbExclamation, "Hinweis")
                        objCell.Value = Empty
                        Exit For
                    End If
                End If
            Next
        Next
        Application.EnableEvents = True
        Set objRang = Nothing
    End If
End Sub

Überwacht wird die komplette Spalte A!!!

Gruß
Nepumuk

Betrifft: AW: doppelte Einträge mit VBA verhindern
von: Nepumuk
Geschrieben am: 15.09.2020 16:17:35

Ooooooooooooops,

da ist noch ein Fehler drin.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim avntValues As Variant
    Dim ialngIdex As Long
    Dim objRang As Range, objCell As Range
    Set objRang = Intersect(Target, Columns(1))
    If Not objRang Is Nothing Then
        Application.EnableEvents = False
        avntValues = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).Value
        For Each objCell In objRang
            For ialngIdex = LBound(avntValues, 1) To UBound(avntValues, 1)
                If ialngIdex <> objCell.Row Then
                    If InStr(1, objCell.Value, avntValues(ialngIdex, 1), vbTextCompare) > 0 Or _
                        InStr(1, avntValues(ialngIdex, 1), objCell.Value, vbTextCompare) > 0 Then
                        Call MsgBox("Doppelter Wert in Zelle ''" & _
                            objCell.Address(False, False) & "''", vbExclamation, "Hinweis")
                        With objCell
                            .Value = Empty
                            Call .Select
                        End With
                        Exit For
                    End If
                End If
            Next
        Next
        Application.EnableEvents = True
        Set objRang = Nothing
    End If
End Sub

Gruß
Nepumuk

Betrifft: AW: doppelte Einträge mit VBA verhindern
von: Sonnenfreund
Geschrieben am: 17.09.2020 11:05:28

Hallo Nepumuk,

sorry für die späte Reaktion, arbeit hat leider keine Zeit gelassen.

Hatte das mal in einer leeren Mappe getestet und direkt beim ersten Eintrag kam schon die Msgbox.

Um das mal besser darstellen zu können, was ich benötige, anbei die Tabelle.

https://www.herber.de/bbs/user/140281.xlsm

Pro Tag muss ein Mitarbeiter unter den Mitarbeitern 1-8 einen 16 Uhr Dienst (16) machen und auch unter den Mitarbeitern 9-16 muss einer einen 16 Uhr Dienst machen.
Zusätzlich muss einer von den Mitarbeitern 1-16 einen 18 Uhr Dienst (18) machen.
Möglich ist auch, dass der 16 Uhr Mitarbeiter gleichzeitig der 18 Uhr Mitarbeiter ist (16/18).
In den Zeilen 5 und 6 sind die regulären Eingaben.

Bei weiteren Eingaben der Dienste 16, 18 und 16/18 pro Zeile soll die Msgbox erscheinen.

Ungeachtet dessen geben die Mitarbeiter auch noch U und AZ ein, diese beiden Eingaben sollen unbeachtet bleiben.

Vielen Dank für die Unterstützung.

Betrifft: AW: doppelte Einträge mit VBA verhindern
von: Herbert_Grom
Geschrieben am: 18.09.2020 09:47:49

Hallo,

ist dein Problem noch aktuell?

Servus

Betrifft: AW: doppelte Einträge mit VBA verhindern
von: Herbert_Grom
Geschrieben am: 18.09.2020 09:47:52

Hallo,

ist dein Problem noch aktuell?

Servus

Betrifft: AW: doppelte Einträge mit VBA verhindern
von: Sonnenfreund
Geschrieben am: 18.09.2020 09:56:14

Moin,

ja, ich bin noch am rumwerkeln, aber wirklich funktionieren tut es leider nicht.

Grüße

Betrifft: AW: doppelte Einträge mit VBA verhindern
von: Herbert_Grom
Geschrieben am: 18.09.2020 10:27:20

Hallo,

ich bin auch am „rumwerkeln“ und bin auf einem guten Weg! Ich melde mich heute Nachmittag!

Servus

Betrifft: AW: doppelte Einträge mit VBA verhindern
von: Herbert_Grom
Geschrieben am: 18.09.2020 12:45:04

Hallo,

schau dir mal meinen Vorschlag an!

https://www.herber.de/bbs/user/140312.xlsm

Servus

Betrifft: AW: doppelte Einträge mit VBA verhindern
von: Sonnenfreund
Geschrieben am: 18.09.2020 14:45:46

Hallo,

da hab ich ein, zu großen Teilen, schon gut funktionierendes Makro.
Vielen Dank!
Werde noch ein paar Regeln für den DAU anlegen und dann hab ich es ;)

Betrifft: AW: doppelte Einträge mit VBA verhindern
von: Herbert_Grom
Geschrieben am: 18.09.2020 15:37:51

Hallo,

gerne geschehen. Danke für die Rückmeldung.

Servus

Beiträge aus dem Excel-Forum zum Thema "doppelte Einträge mit VBA verhindern "