Office: (Office 2016) Termin reservieren und blockieren Exceltabelle

Servus zusammen,

Ich möchte für unsere Mitarbeiter eine Excelliste erstellen in der sie einen Termin Reservieren können.
Dazu hat die Datei 2 Tabellenblätter.
Das 2. Tabellenblatt wird durch unser Team befüllt uns ist sonst per visible = xlVeryHidden
ausgeblendet. Das kann ich soweit auch durch VBA ermöglichen.

Nun soll im Tabellenblatt2 ("Intern") eine Liste wie folgt aufgebaut sein
A B C D E
Name, Vorname Team Uhrzeit


Unter Uhrzeit möchte ich nun mehrere Uhrzeiten(Termine) eintragen die Verfügbar sind.
Im Tabellenblatt1("Terminreservierung") möchte ich nur eine Tabelle mit 2 Zeilen(Überschrift und Eingabefeld) mit selben Kategorien eintragen. Ich dachte an ein Dropdownmenü im Feld Uhrzeit. Dann trägt der Mitarbeiter seine Daten ein und durch druck auf einen Button werden seine Daten in die entsprechende Zeile in Tabelle 2 übertragen.
Wichtig wäre dabei das danach diese Uhrzeit im Dropdownmenü nicht mehr zur Verfügung steht. Durch leeren der Felder B und C im Tabellenblatt2("Intern") möchte ich den Termin aber wieder freigeben.

Kann mir da jemand weiterhelfen ?
Ich habe zuhause leider nur eine OpenOffice Alternative, benutze auf der Arbeit aber Office 2016.

Ich weiß wie ich Daten per VBA in das Verborgene Tabellenblatt übertrage, weiß aber nicht wie ich die entsprechende Zeile(Uhrzeit) auswähle und wie ich diese Zeile dann solange sie belegt ist im Dropdownmenü Sperre oder ausblende.

Hoffe jemand kann mein Problem nachvollziehen und mir bei den beiden Sachen einen Tip geben.
Ich bin ziemlicher VBA Neuling, kann Logische Abfragen allerdings nachvollziehen und kenne mich mit Excelformeln einigermaßen gut aus.

Vielen Dank und bleibt Gesund

Gruß
Eddy

 

Leider finde ich keine Möglichkeit meinen Post zu Bearbeiten.
Kann mir jemand den Code nennen wie ich anhand der Zelle mit der Uhrzeit(per Dropdown ausgewählt) die passende Zeile im Tabellenblatt2 finde ? Ich denke zwar das ich dazu eine Variable erstellen muss, die als Wert die ausgewählte Uhrzeit nimmt. Leider bin ich da komplett raus und wäre über einen Tipp oder den Grundbaustein sehr erfreut.

 

benutze Vergleich()

nur wenige schauen auf Deinen Rechner und sehen die Datei.
Ich möchte gerne den Fehler im Original sehen.

Ich baue keine Datei nach. Die Zeit hat schon jemand investiert.

Ein Nachbau sieht meist anders aus als das Original. <B>Darum sollte das Original verlinkt werden.</b>

Wenn du an Stelle einer Demomappe deine Originalmappe hochladen willst, diese aber sensible Daten enthält, kannst du diese Daten
Hinweis - Anonymisierung und Pseudonymisierung von Beispielmappen - MS-Office-Forum
änderrn.
Der Name einer hochgeladenen Mappe wird im Beitrag automatisch angezeigt, sodass es bei Verwendung von aussagekräftigen Namen leichter fällt, sie später im Ablageordner wiederzufinden und sie gedanklich einem bestimmten Thema zuzuordnen. Namen wie Muster, Test, Mappe, Beispiel, Fehler, Kalender usw. sind so allgemein, dass eine Zuordnung zu einem Thema unmöglich gemacht wird.
Es sollte ein aussagekräftiger Name sein.

Benutze hier im Forum die Funktion zum hochladen. Falls Du die nicht benutzen möchtest beachte, von unsicheren Servern wie z.B. www.file-upload.net lade ich keine Datei runter. (lt. Einschätzung meines Virenprogramms)3

Bilder lade ich mir nicht runter, da Excel damit nichts anfangen kann.

Bilder statt Datei | Excel ist sexy!

Hochgeladene Bilder können zwar als solche in Excel importiert werden, sind jedoch bei der Lösung von Problemen nicht sehr hilfreich, da man die eigentlichen Daten nicht ohne große und zeitraubende Umwege direkt in die Tabelle übertragen kann.

Das ist nur meine Meinung zu dem Thema.

 

Hallo Hajo,

vielen Dank schon mal für deine Antwort. Ich kann deine Antwort nachvollziehen und werde am Montag versuchen eine Demodatei aus dem Firmennetzwerk hoch zu laden. Eventuell kann ich bis dahin ja ein wenig forschen wie ich generell eine Variable speicher um damit die Zielzelle in einer Tabelle zu finden.

Vielen Dank schon mal und ein schönes Wochenende

Gruß Eddy

 

Ich melde mich jetzt leider etwas später, aber ich denke das ich mein Problem selbst lösen konnte.
Ich wäre aber froh darüber wenn jemand der sich besser mit VBA auskennt mal über meinen Code unten schauen kann.
Aktuell funktioniert er wie er soll. Aber eventuell sieht jemand ja grobe schnitzer die man ausbügeln sollte weil sie evtl Fehleranfällig sind.

Vielen Dank und bleibt Gesund
Gruß Eddy


Sub Einblenden()

Dim sPassword As String

sPassword = InputBox("Paßwort eingeben:", , "")

Select Case sPassword

Case ""

With Worksheets("Intern")

.Visible = True

End With

Case " "

Case Else

Beep

MsgBox "Falscheingabe"

End Select

End Sub


Sub Ausblenden()

Worksheets("Intern").Visible = xlVeryHidden

End Sub


Sub Termin_reservieren()

If ActiveSheet.Range("F6").Text = "" Then

MsgBox "Bitte wählen Sie eine Uhrzeit über das Dropdownmenü aus.", vbCritical

Exit Sub

End If

If ActiveSheet.Range("C6").Text = "" Then

MsgBox "Bitte tragen Sie Ihren Namen und Vornamen ein.", vbCritical

Exit Sub

End If


If ActiveSheet.Range("D6").Text = "" Then

MsgBox "Bitte tragen Sie Ihren Standort ein.", vbCritical

Exit Sub

End If


If ActiveSheet.Range("E6").Text = "" Then

MsgBox "Bitte tragen Sie Ihre Teamkennung ein.", vbCritical

Exit Sub

End If


'Variablen deklarieren

Dim TerminTime As Variant

Dim ZielZeile As Variant


'Suchwort =Inhalt von Zelle F6 (Uhrzeit per Dropdownmenü)

TerminTime = Sheets("Reservierung").Range("F6").Value

'Wenn Zelle Leer dann beende Makro

If TerminTime = "" Then Exit Sub


ZielZeile = Worksheets("Intern").Range("F6:F34").Find(What:=TerminTime, After:=ActiveCell, _

LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row


Sheets("Reservierung").Range("C6:E6").Copy _

Destination:=Sheets("Intern").Range("C" & ZielZeile & ":E" & ZielZeile)

Sheets("Reservierung").Range("C6:F6").ClearContents

ActiveWorkbook.Save


End Sub

 

Hallo,

ich habe mir deinen VBA-Code angesehen und habe ein paar Änderungen vorgenommen:
1) In der SUB Termin_reservieren habe ich die Überprüfung auf fehlende Daten so zusammengefasst, dass alle fehlenden Daten in einem Aufwasch angezeigt werden. Das ist sicher für die Leute angenehmer, als wenn viermal hintereinander fehlende Daten nachgefordert werden.
2) Ferner habe ich angenommen, dass diese Datenüberprüfung im Arbeitsblatt "Reservierung" stattfindet (statt im ActiveSheet).
3) Vor dem Terminübertrag ins Arbeitsblatt "Intern" wird ein Suchlauf nach dem Termin durchgeführt. Hier könnte/kann es passieren, dass der eingegebene Termin nicht gefunden wird. Die FIND-Methode liefert in diesem Fall NOTHING, womit die Row-Eigenschaft nichts anfangen kann und somit mit einem Runtime-Fehler abbricht. Für diesen Fall habe ich eine Fehlerbehandlung eingebaut ("On Error GoTo Err_Termin_Res"), sodass im Fehlerfall das Programm zur Messagebox-Anzeige am Ende springt und keine Kopierung und auch keine Speicherung ausführt.

Code:

Option Explicit

Sub Einblenden()

  Dim sPassword As String

  sPassword = InputBox(Prompt:="Passwort eingeben:", Default:="")
  Select Case sPassword
    Case ""                                   '<-- Passwort ?
      Worksheets("Intern").Visible = True
    Case " "
    Case Else
      Beep
      MsgBox "Falscheingabe"
  End Select

End Sub

Sub Ausblenden()
  Worksheets("Intern").Visible = xlVeryHidden
End Sub

Sub Termin_reservieren()
  Dim Mldg As String
 
  Mldg = ""
  With Worksheets("Reservierung")
    If .Range("F6").Text = "" Then
      Mldg = "Bitte wählen Sie eine Uhrzeit über das Dropdownmenü aus." & vbNewLine
    End If
  
    If .Range("C6").Text = "" Then
      Mldg = Mldg & "Bitte tragen Sie Ihren Namen und Vornamen ein." & vbNewLine
    End If
  
    If .Range("D6").Text = "" Then
      Mldg = Mldg & "Bitte tragen Sie Ihren Standort ein." & vbNewLine
    End If
  
    If .Range("E6").Text = "" Then
      Mldg = Mldg & "Bitte tragen Sie Ihre Teamkennung ein."
    End If
  
    If Len(Mldg) Then
      MsgBox Prompt:=Mldg, Buttons:=vbCritical, Title:="Fehlende Daten"
      Exit Sub
    End If
  
  End With
 
  'Variablen deklarieren
 
  Dim TerminTime As Variant
  Dim ZielZeile As Long
 
  With Worksheets("Reservierung")
    'Suchwort =Inhalt von Zelle F6 (Uhrzeit per Dropdownmenü)
    TerminTime = .Range("F6").Value
  
    'Wenn Zelle Leer dann beende Makro
    If TerminTime = "" Then Exit Sub
    On Error GoTo Err_Termin_Res
  
    'Wenn FIND den Termin nicht findet, dann -->Err_Termin_Res
    ZielZeile = Worksheets("Intern").Range("F6:F34").Find(What:=TerminTime, After:=ActiveCell, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row
              
    .Range("C6:E6").Copy Destination:=Worksheets("Intern").Range("C" & ZielZeile)
    .Range("C6:F6").ClearContents
  End With
 
  ActiveWorkbook.Save
  Exit Sub
 
Err_Termin_Res:
  MsgBox Prompt:="Der Termin " & TerminTime & " konnte nicht gefunden werden." & vbNewLine & vbNewLine & _
                 "Bitte korrekten Termin (nochmals) eintragen!", _
         Buttons:=vbCritical, _
         Title:="Falscher Termin"
End Sub

 

Hallo Anton und vielen lieben Dank für dein Feedback,

der Part mit der Meldung bei fehlenden Einträgen ist super und den werde ich auch so in meine Datei übernehmen, Vielen dank auch dafür!

die Liste der Termine wird über eine WENN Formel immer aktualisiert.
Sprich hinter den Uhrzeiten(Termine) die von meinem Team erfasst werden, wird mit folgender Formel geprüft welche Termine belegt sind. =WENN(D2="";"";WENN(A2="";D2;""))

In Spalte A, B und C werden die die Parameter Name/Vorname(A), Standort(B) und Teamkennung(C) erfasst. In Spalte D stehen die von meinem Team eingetragenen Uhrzeiten. in E steht(Versteckt und gesperrt damit niemand die Zellebearbeitet) die o.g. Formel. Und auf den Bereich in E habe ich eine Datenüberprüfung gemacht um dort im Tabellenblatt Reservierung eine entsprechende Dropdownliste zu haben.
Bzw. über eine Indexfunktion und eine weitere Hilfsspalte, liste ich nochmal alle verfügbaren Termine ohne Leerzeile auf und habe die Datenüberprüfung darauf geändert.

Spaltenangaben hier nur der Übersicht halber angepasst, sehen in der Datei ein wenig Verteilter aus dort stehen die Uhrzeiten in der Spalte F, da um das ganze Konstrukt noch das Layout angepasst wurde/wird.

Vielen Dank auf jeden fall für dein Feedback und ich kann davon auf jeden fall einiges in zukünftige Projekte mitnehmen, da ich noch ziemlich neu in VBA bin. Ich beschäftige mich damit seit ca. 2 Monaten.

NACHTRAG: wie müsste ich den part des kopieren und einfügens ändern, so das er nur den Inhalt also .Values ohne z.b. die Rahmen und Färbung der Zelle kopiert und einfügt?

Viele Grüße und bleib Gesund
Eddy

 

Hallo,

Statt wie bisher

Code:

With Worksheets("Reservierung")
'....
    .Range("C6:E6").Copy Destination:=Worksheets("Intern").Range("C" & ZielZeile)
'....
End With

müsste es dann lauten:

Code:

With Worksheets("Reservierung")
'....
    .Range("C6:E6").Copy
    Worksheets("Intern").Range("C" & ZielZeile).PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationNone
'....
End With

 

Hallo Anton und Vielen Dank für die Antwort,

das werde ich doch direkt mal anpassen :)

Viele Grüße
Eddy

 

Hallo Anton

Ich muss mich leider nochmal melden, wenn ich den Code so wie von dir gepostet eintrage, wird diese Codezeile rot dargestellt und ich bekomme den Fehler "Fehler beim Kompilieren: Erwartet: Anweisungsende und in VBA markiert er mir das Paste nach dem .PasteSpecial.

Kannst du mir da nochmal weiterhelfen ?

Danke

 

Hallo,

hast du die zwei Codezeilen exakt so eingegeben? Ich schicke dir den Code aus meiner Datei:

Code:

Option Explicit

Sub Einblenden()

  Dim sPassword As String

  sPassword = InputBox(Prompt:="Passwort eingeben:", Default:="")
  Select Case sPassword
    Case ""                                   '<-- Passwort ?
      Worksheets("Intern").Visible = True
    Case " "
    Case Else
      Beep
      MsgBox "Falscheingabe"
  End Select

End Sub

Sub Ausblenden()
  Worksheets("Intern").Visible = xlVeryHidden
End Sub

Sub Termin_reservieren()
  Dim Mldg As String
 
  Mldg = ""
  With Worksheets("Reservierung")
    If .Range("F6").Text = "" Then
      Mldg = "Bitte wählen Sie eine Uhrzeit über das Dropdownmenü aus." & vbNewLine
    End If
  
    If .Range("C6").Text = "" Then
      Mldg = Mldg & "Bitte tragen Sie Ihren Namen und Vornamen ein." & vbNewLine
    End If
  
    If .Range("D6").Text = "" Then
      Mldg = Mldg & "Bitte tragen Sie Ihren Standort ein." & vbNewLine
    End If
  
    If .Range("E6").Text = "" Then
      Mldg = Mldg & "Bitte tragen Sie Ihre Teamkennung ein."
    End If
  
    If Len(Mldg) Then
      MsgBox Prompt:=Mldg, Buttons:=vbCritical, Title:="Fehlende Daten"
      Exit Sub
    End If
  
  End With
 
  'Variablen deklarieren
 
  Dim TerminTime As Variant
  Dim ZielZeile As Long
 
  With Worksheets("Reservierung")
    'Suchwort =Inhalt von Zelle F6 (Uhrzeit per Dropdownmenü)
    TerminTime = .Range("F6").Value
  
    'Wenn Zelle Leer dann beende Makro
    If TerminTime = "" Then Exit Sub
    On Error GoTo Err_Termin_Res
  
    'Wenn FIND den Termin nicht findet, dann -->Err_Termin_Res
    ZielZeile = Worksheets("Intern").Range("F6:F34").Find(What:=TerminTime, After:=ActiveCell, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row
              
    .Range("C6:E6").Copy
    Worksheets("Intern").Range("C" & ZielZeile).PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationNone
    .Range("C6:F6").ClearContents
  End With
 
  ActiveWorkbook.Save
  Exit Sub
 
Err_Termin_Res:
  MsgBox Prompt:="Der Termin " & TerminTime & " konnte nicht gefunden werden." & vbNewLine & vbNewLine & _
                 "Bitte korrekten Termin (nochmals) eintragen!", _
         Buttons:=vbCritical, _
         Title:="Falscher Termin"
End Sub

 

Ok ich habe den Fehler gefunden, ich hatte die Zeile Copy und die Zeile Paste noch per _ verbunden.

Fehler habe ich mittlerweile behoben und es funktioniert jetzt wie gewollt.

Danke dir