Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Excel VBA keine doppelten werte bis auf eine Zahl!
#1
Question 
Guten Morgen zusammen,

ich habe ein kleines Problem.
Ich möchte in einer spalte keine doppelten Werte bis auf eine bestimmte zahl z.b.: 200100 darf doppelt oder auch öfter vorkommen.
Ich habe zur Ermittlung von doppelten werten folgenden Code.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Set Bereich = Range("A5:A3005")
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Intersect(Bereich, Target) Is Nothing Then Exit Sub
If WorksheetFunction.CountIf(Bereich, Target.Value) > 1 Then
    Beep
    UserForm1.Show
    Application.EnableEvents = False
    Target.Value = ""
    Application.EnableEvents = True
    Target.Select
End If
    Dim objRange As Range, objCell As Range
    Set objRange = Intersect(Target, Range("A5:A3005"))
    If Not objRange Is Nothing Then
        Application.EnableEvents = False
        For Each objCell In objRange
            If Not IsEmpty(objCell.Value) Then
                objCell.Offset(0, 1).Value = Now
            Else
                objCell.Offset(0, 1).Value = Empty
            End If
        Next
        Application.EnableEvents = True
    End If
End Sub

Nun wollte ich fragen wie ich diesen Code ändern soll damit er z.b. den Wert 200100 nicht berücksichtigt.

Danke & viele Grüße.
Antwortento top
#2
Hallo,

Code:
If WorksheetFunction.CountIf(Bereich, Target.Value) > 1 And Target.Value <> 200100 Then

Gruß Uwe
Antwortento top
#3
Falls dies nicht umsetzbar ist würde mir eine Änderung des Codes auf nur Numerische Kontrolle der doppelten werte weiterhelfen.

Danke & viele Grüße.

EDIT:

Entschuldigung hab erst jetzt gesehen das du auf mein Problem geantwortet hast.

Danke dir für deine Antwort!

Mein Problem ist nun damit gelöst.Smile
Antwortento top
#4
Hallo zusammen,

der Code oben lässt keine Doppelten Werte zu bis auf die 200000.
Wie müsste ich den Code verändern wenn ich auch alle Zahlen die mit *999 enden erlauben möchte?

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Set Bereich = Range("A5:A3005")
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Intersect(Bereich, Target) Is Nothing Then Exit Sub
If WorksheetFunction.CountIf(Bereich, Target.Value) > 1 And Target.Value <> 200100 Then 'Auswahl der Zahl die doppelt gescannt werden darf. Unbekannt Aktuell "200000"
    Beep
    UserForm1.Show
    Application.EnableEvents = False
    Target.Value = ""
    Application.EnableEvents = True
    Target.Select
End If
    Dim objRange As Range, objCell As Range
    Set objRange = Intersect(Target, Range("A5:A3005"))
    If Not objRange Is Nothing Then
        Application.EnableEvents = False
        For Each objCell In objRange
            If Not IsEmpty(objCell.Value) Then
   objCell.Offset(0, 1).Value = Now
            Else
                objCell.Offset(0, 1).Value = Empty
            End If
        Next
        Application.EnableEvents = True
    End If

Danke & viele Grüße.
Antwortento top
#5
Hallo,

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Bereich As Range
  Dim objRange As Range, objCell As Range
  
  Set Bereich = Range("A5:A3005")
  If Target.Cells.Count > 1 Then Exit Sub
  If Target.Value = "" Then Exit Sub
  If Intersect(Bereich, Target) Is Nothing Then Exit Sub
  If WorksheetFunction.CountIf(Bereich, Target.Value) > 1 Then
    If Target.Value <> 200100 And Right(Target.Value, 3) <> "999" Then 'Auswahl der Zahl die doppelt gescannt werden darf. Unbekannt Aktuell "200000"
        Beep
        UserForm1.Show
        Application.EnableEvents = False
        Target.Value = ""
        Application.EnableEvents = True
        Target.Select
    End If
    Set objRange = Intersect(Target, Bereich)
    If Not objRange Is Nothing Then
        Application.EnableEvents = False
        For Each objCell In objRange
            If Not IsEmpty(objCell.Value) Then
                objCell.Offset(0, 1).Value = Now
            Else
                objCell.Offset(0, 1).Value = Empty
            End If
        Next
        Application.EnableEvents = True
    End If
    End If
  End If
End Sub

Gruß Uwe
[-] Folgende(r) 1 Benutzer sagt Danke an Kuwer für diesen Beitrag:
  • Pascala
Antwortento top
#6
Vielen vielen Dank Uwe!

Klappt Super.
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste