Eingabe auf bestimmte Anzahl beschränken

Hallo zusammen,
folgende Situation:
(1). Ich gebe ein beliebiges Datum ein (Inputbox) (Z.B.: 01.04.2022)
(2). In der Tabelle1 existieren bereits mehrfach vorhandene Einträge mit verschiedenen Uhrzeiten zu diesem Datum:
Als Beispiel:
09:30
09:30
09:30
10:35
12:00
12:00
usw.
Möchte jetzt:
(I). Nach der Feststellung:
- Die Anzahl der Neueingaben von weiteren Uhrzeiten beispielsweise auf 10 beschränken.
- Beim Überschreiten dieser Grenze, soll eine Meldung erfolgen und Abbruch signalisiert werden!
(II). Tabelle1 beinhaltet: Sämtliche Einträge
(III). Tabelle4 (Pivot Tabelle) filtert alle Uhrzeiten zum eingegebenen Datum (Bei Eingabe eines Datums werden
Alle Einträge mit dazugehörigen Uhrzeiten und deren Häufigkeiten gefiltert und korrekt angezeigt)!
Frage: Wie kann ich erreichen: Wenn ich eine "Neueingabe" beim Überschreiten dieser Grenze ( 10 Einträge), verhindern möchte?
ich habe eine Vielzahl an Abfrage-Varianten ausprobiert aber leider ohne Erfolg!
Kann mir jemand weiterhelfen?
Ich bin für euere Vorschläge sehr dankbar
Viele Grüße
Nader

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Const cEingabeBereich = "B2:B50" Const cMaxEingabe = 10 Set Target = Target.Range("A1") 'immer nur die erste Zelle If Not Intersect(Target, Range(cEingabeBereich)) Is Nothing Then If Eingabe_zählen(CStr(Target.Offset(0, -1).Value), Range(cEingabeBereich).Offset(0, -1), Range(cEingabeBereich)) > cMaxEingabe Then MsgBox "Es wurde für " & Target.Offset(0, -1) & " mehr als " & cMaxEingabe & " Eingaben gemacht!", vbCritical, "Rejected" Application.EnableEvents = False Target.Value = "" Application.EnableEvents = True End If End If End Sub Private Function Eingabe_zählen(ByVal Prüfdatum As String, ByVal DatumBereich As Range, ByVal EingabeBereich As Range) Dim Z Dim i Dim Erg For Each Z In EingabeBereich.Cells i = i + 1 If CStr(DatumBereich.Cells(i, 1).Value) = Prüfdatum Then If EingabeBereich.Cells(i, 1) "" Then Erg = Erg + 1 End If Next Eingabe_zählen = Erg End Function

Hallo Yal,
vielen Dank für deine rasche Antwort
Leider könnte ich deine Routine noch nicht in meinem bestehenden Code benutzen, weil ich nicht genau weiß, wo deine Routine
eingesetzt wird.
Kannst du mir bitte dabei behilflich sein und mir zeigen, wo ich die Routine einsetzen kann?
Meine Routine:
Option Explicit


Private Sub CommandButton1_Click()
Unload UF_Status_Vorbestellungen
End Sub


Private Sub CommandButton2_Click()
Dim SuchDatum As Variant
Dim Rng As Range
'Teil (1) Pivot Tabelle aktualisieren
Sheets("Tabelle4").Activate
ThisWorkbook.RefreshAll
'Teil (2) Eingabe vom Datum über Inputbox
SuchDatum = InputBox("Datum eingeben!")
If IsDate(SuchDatum) Then
With Sheets("Tabelle1").Range("A:A")
Set Rng = .Find(What:=CStr(SuchDatum), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True 'value found
Sheets("Tabelle4").PivotTables("PivotTable1").PivotFields("Datum").CurrentPage = SuchDatum
Else
Dim iCounter As Integer
For iCounter = 64 To 64
MsgBox "Das gewählte Datum ist nicht vorhanden!", iCounter, "Information..."
Next iCounter
End If
End With
End If
End Sub


Private Sub UserForm_Initialize()
'Anzeigen ListBox1
Dim lLetzte1  As Long
Application.ScreenUpdating = False
ListBox1.Clear
With Worksheets("Tabelle4")
lLetzte1 = .Cells(Rows.Count, 1).End(xlUp).Row
With Me.ListBox1
.ColumnCount = 4
' ListBox1.Selected(0) = True
.ColumnHeads = False
.Font.Size = 18
ListBox1.RowSource = "Tabelle4!A4:K4" & lLetzte1
End With
End With
Application.ScreenUpdating = True
ListBox1.ColumnWidths = "12,0 Cm;8,0 Cm;2,0 Cm;5,0 Cm"
End Sub

Beliebteste Forumthreads (12 Monate)

Eingabe auf bestimmte Anzahl beschränken

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Eingabe auf bestimmte Anzahl beschränken

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread