Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1876to1880
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Eingabe auf bestimmte Anzahl beschränken

Eingabe auf bestimmte Anzahl beschränken
04.04.2022 15:13:51
Nader
Hallo zusammen,
folgende Situation:
Tabelle1 besteht aus verschiedenen Informationen (Hier geht es um zwei Spalten davon).
Spalte (A) Das Datum
Spalte (C) Die Uhrzeit
Situation:
Es sollen nur maximal 10 Zeiteingaben zu jeder Stunde zulässig sein.
Zum Beispiel: Datum: 04.04.2022
Zeiteingaben: 10:00, 10:00, 10:00,...............................10:00 (10 X), falls weitere Eingabe (Nr. 11) für diese Uhrzeit gemacht wird, soll durch eine Meldung
eine Warnung herausgegeben werden und anschließend soll die Routine zur Subroutine (Eingabe) zurückkehren!
Mein Problem besteht darin, dass die Routine schon bei der Eingabe vom Datum aber auch Uhrzeit, erkennen muss, ob schon eine weitere Uhrzeit
zu diesem Datum zulässig ist oder nicht!
Das heißt ungefähr so, dass die ComboBox_Datum und TextBox_Uhrzeit mit Daten aus der Tabelle befüllt werden müssen, dann werden diese Daten
mit der Neueingabe verglichen und die Routine erkennt auch die Zulässigkeit oder auch nicht, danach erfolgt die Meldung!!!!!!!
Mein Code, um die Tabelle1 mit Daten zu versorgen:
Option Explicit
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
'Bildschirmauflösung des Bildschirms an dem die Userform erstellt wurde
Const LHorizontale As Long = 1920
Const LVertikal As Long = 1080

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
ThisWorkbook.RefreshAll
Application.EnableEvents = True
End Sub

Private Sub CommandButton5_Click()
Unload UF_VB_Aufnehmen
End Sub

Private Sub CommandButton2_Click()
Dim Last As Integer
Last = Worksheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row + 1
Worksheets("Tabelle1").Cells(Last, 1).Value = ComboBox_Datum.Value
Worksheets("Tabelle1").Cells(Last, 3).Value = TextBox_Uhrzeit.Value
Worksheets("Tabelle1").Cells(Last, 7).Value = TextBox_Name
If ComboBox_Außerhalb.Value = "" Then
Worksheets("Tabelle1").Cells(Last, 8).Value = "Flensburg"
Else
Worksheets("Tabelle1").Cells(Last, 8).Value = ComboBox_Außerhalb.Value
End If
Worksheets("Tabelle1").Cells(Last, 19).Value = ComboBox_A.Value
Worksheets("Tabelle1").Cells(Last, 20).Value = TextBox_HausNr
Worksheets("Tabelle1").Cells(Last, 10).Value = ComboBox_Bemerkungen
Worksheets("Tabelle1").Cells(Last, 21).Value = TextBox_PKWBUS
Worksheets("Tabelle1").Cells(Last, 12).Value = TextBox_Vorlaufzeit.Value
'Aktualisierung der Tabelle1
With Worksheets("Tabelle1")
.Range("A2:N20000").Sort Key1:=.Range("N1"), order1:=xlAscending, Header:=xlNo, MatchCase:=False, Orientation:=xlTopToBottom
End With
End Sub

Private Sub CommandButton6_Click()
With Columns("A:AK")
.Sort Key1:=Range("K1"), Key1:=Range("L1"), Header:=xlYes
End With
End Sub

Private Sub UserForm_Initialize()
'Befüllen
With Worksheets("FlensburgerStrassen")
ComboBox_A.List = .Range(.Cells(1, 1), .Cells(.UsedRange.Rows.Count, 1)).Value
End With
ComboBox_A.ListIndex = 1
'Datum (ComboBox-Datum, befüllen
Dim Datum As Long
For Datum = CLng(CDate("14.12.2020")) To CLng(CDate("31.12.2050"))
UF_VB_Aufnehmen.ComboBox_Datum.AddItem CDate(Datum)
Next Datum
UF_VB_Aufnehmen.ComboBox_Datum.ListIndex = CLng(Now) - 1 - CLng(CDate("14.12.2020"))
'Befüllen ComboBox_Bemerkungen
With Worksheets("Bemerkungen")
ComboBox_Bemerkungen.List = .Range(.Cells(1, 1), .Cells(.UsedRange.Rows.Count, 1)).Value
End With
ComboBox_Bemerkungen.ListIndex = 1
'Befüllen ComboBox_Außerhalb
With Worksheets("Außerhalb")
ComboBox_Außerhalb.List = .Range(.Cells(1, 1), .Cells(.UsedRange.Rows.Count, 1)).Value
End With
ComboBox_Außerhalb.ListIndex = 1
'Anzeigen ListBox1
Dim lLetzte1  As Long
Application.ScreenUpdating = False
ListBox1.Clear
With Range("Tabelle1!A2:K2")
With Worksheets("Tabelle1")
lLetzte1 = .Cells(Rows.Count, 1).End(xlUp).Row
With Me.ListBox1
.ColumnCount = 11
' ListBox1.Selected(0) = True
.ColumnHeads = False
.Font.Size = 19
ListBox1.RowSource = "Tabelle1!A2:K2" & lLetzte1
End With
End With
Application.ScreenUpdating = True
ListBox1.ColumnWidths = "3,3 Cm;0,5 Cm;2,3 Cm;2,5 Cm;4,5 Cm;4,5 Cm;6,0 Cm;6,0 Cm;8,5 Cm;9,0 Cm;1,5 Cm"
End With

Private Sub TextBox_Uhrzeit_Afterupdate()
Dim tString As String
Dim tDate As Date
On Error GoTo ErrMsg
With TextBox_Uhrzeit
'Check if user put in a colon or not
If InStr(1, .Value, ":", vbTextCompare) = 0 Then
'If not, make string 4 digits and insert colon
tString = Format(.Value, "0000")
tDate = TimeSerial(Left(tString, 2), Right(tString, 2), 0)
TextBox_Uhrzeit.Value = Format(tDate, "HH:MM")
Else
'Otherwise, take value as given
.Value = Format(.Value, "hh:mm")
End If
End With
Exit Sub
ErrMsg:
MsgBox "Oops! Etwas läuft völlig falsch.", vbOKOnly, "Unexpected entry"
End Sub

Private Sub CommandButton40_Click()
Dim rngCell As Range
Dim strFirstAddress As String
With Worksheets("FlensburgerStrassen").Range("A:A")
Me.ComboBox_A.Clear.Contents
Set rngCell = .Find(Me.TextBox1.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not rngCell Is Nothing Then
strFirstAddress = rngCell.Address
Do
With Me.ComboBox_A
.ColumnCount = 1
.AddItem
.List(.ListCount - 1, 0) = rngCell.Value
.List(.ListCount - 1, 1) = rngCell.Offset(0, 1).Value
End With
Set rngCell = .FindNext(rngCell)
Loop While Not rngCell Is Nothing And rngCell.Address  strFirstAddress
Else
MsgBox "Adresse nicht gefunden", 48
End If
End With
End Sub

Private Sub CommandButton41_Click()
Dim wks As Worksheet
Set wks = Worksheets("Tabelle1")
With Me.ComboBox_A
wks.Range("A6").Value = .List(.ListIndex, 0)
End With
End Sub
Kann mir jemand bitte helfen
Ich bin euch sehr dankbar für Eure Vorschläge
Viele Grüße
Nader

16
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Warum machst du immer einen neuen Thread auf? owT
04.04.2022 15:16:24
SF
AW: Warum machst du immer einen neuen Thread auf? owT
04.04.2022 15:22:27
Nader
Hallo,
vielleicht deshalb, weil ich erst seit kurzer Zeit bei einer Forum teilnehme!
Ich werde mich noch bessern.
Danke dir für deinen freundlichen Hinweis.
Gruß
Nader
AW: Warum machst du immer einen neuen Thread auf? owT
04.04.2022 15:29:56
onur
Ist ja auch nicht einfach zu bedienen, so eine Forumssoftware. Ich habe jahre gebraucht, um zum ersten Mal antworten zu können.
AW: Eingabe auf bestimmte Anzahl beschränken
04.04.2022 15:19:22
onur
Tolle Beschreibung deiner Datei.
Statt des ganzen Codes solltest du besser die (Beispiels-) Datei posten, denn der Code ohne die Datei ist fast nix wert.
AW: Eingabe auf bestimmte Anzahl beschränken
04.04.2022 15:41:27
Nader
Hallo onur,
deine Bemerkung ist vollkommen richtig, aber es handelt sich hier um ein umfangreiches Programm (fast 15 MB),
glaube nicht, dass ich eine Datei in dieser Größe hochladen darf!
Hast du eine Idee?
Gruß
Nader
Anzeige
AW: Eingabe auf bestimmte Anzahl beschränken
04.04.2022 15:47:46
onur
Es würde schon helfen, wenn die Datei (die ggf abgespeckte) Tabelle1 enthielte, und natürlich die Userform und den relevanten Code, so dass man den Code auch mal testen kann.
AW: Eingabe auf bestimmte Anzahl beschränken
04.04.2022 21:01:18
Nader
Hallo onur,
ich habe die abgespeckte Version des Programmteils vorbereitet.
Hoffentlich ist hilfreich!
Danke dir Vielmals im Voraus
Gruß
Nader
AW: Eingabe auf bestimmte Anzahl beschränken
04.04.2022 21:13:41
onur
Dann solltest du sie auch mal posten.
AW: Eingabe auf bestimmte Anzahl beschränken
04.04.2022 21:14:07
Nader
Ich habe bis jetzt mehrmals versucht die Datei zum Server zu schicken, die Bestätigung kommt auch:
https://www.herber.de/bbs/user/152252.xlsm (erscheint aber nicht in meinem Beitrag)
Anzeige
AW: Eingabe auf bestimmte Anzahl beschränken
04.04.2022 21:15:08
onur
So ist es korrekt, du musst den Link posten.
AW: Eingabe auf bestimmte Anzahl beschränken
08.04.2022 11:45:00
Nader
Hallo onur,
ich wollte mal hören, ob du zufällig eine Lösung für meine Frage gefunden hast?
Ich habe inzwischen mit dem Vorschlag von "YAL" experimentiert, aber leider ohne Erfolg:

Private Sub Worksheet_Change(ByVal Target As Range)
Const cEingabeBereich = "C2:C50"
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
Gruß
Nader
Anzeige
AW: Eingabe auf bestimmte Anzahl beschränken
10.04.2022 21:24:34
Nader
Hallo Zusammen,
für mein Problem, das ich habe, wurden Freundlicherweise einige Lösungen vorgeschlagen, aber leider war keine davon eine Problemlösung.
Mein Problem in Kürze ist:
Bei einer Neueingabe einer Uhrzeit für einen bestimmten Wochentag, soll geprüft werden, ob diese Neueingabe
die schon existierende Anzahl der Einträge (in der Tabelle1) von 10, nicht übersteigt, bei einer Übersteigung, soll dieses Ereignis mittels einer
Message-Box gemeldet werden, damit eine Eingabe einer anderen Uhrzeit für dieses Datum gemacht werden kann!
Situation:
Datum: 11.04.2022
Existierende Uhrzeiten (zum Beispiel): zwischen 07:00 Uhr und 08:00 Uhr 5 Einträge
zwischen 08:00 Uhr und 09:00 Uhr 10 Einträge (Hier soll das Ereignis eine Neueingabe für diese Uhrzeit, verhindern)!
"Und dies ist mein Problem".
Kann mir jemand weiter helfen?
Gruß
Nader

Anzeige
AW: Eingabe auf bestimmte Anzahl beschränken
10.04.2022 21:44:24
onur
"zwischen 08:00 Uhr und 09:00 Uhr 10 Einträge" ? WO sollen diese 10 denn sein? Ich sehe da nur insgesamt 3 Einträge.
AW: Eingabe auf bestimmte Anzahl beschränken
10.04.2022 22:09:57
Nader
Hi onur,
das heißt: bei einer Neueingabe für den 11.04.2022 und zwar zwischen 09:00 und 10:00 Uhr
sollte durch eine Meldung (MsgBox) die Eingabe verhindert werden, da schon 10 Einträge für diesen Zeitraum existieren,
und die Routine soll erneut für eine andere Uhrzeit wiederholt werden!
Anzeige
AW: Eingabe auf bestimmte Anzahl beschränken
10.04.2022 23:08:48
onur
Füge das bei der Useform hinzu:

Private Sub TextBox_Uhrzeit_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Last As Integer, zeit As Double
Dim x, zt1, zt2, b1, b2
CommandButton2.Enabled = True
With Worksheets("Tabelle1")
Last = .Cells(Rows.Count, 1).End(xlUp).Row + 1
zeit = Hour(CDate(TextBox_Uhrzeit))
zt1 = zeit / 24: zt2 = (zeit + 1) / 24
b1 = Replace(">=" & zt1, ",", "."): b2 = Replace(" 9 Then
MsgBox "Alarm"
CommandButton2.Enabled = False
'usw
'usw
End If
End With
End Sub

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige