Office: (Office 2016) Datumssuche mit Inputbox

Hallo Gemeinde,

ich bin mit meinem Laienlatein am Ende und hoffe hier des Rätsels Lösung zu finden. Mein Projekt ist ein Dienstplaner. Jede Abteilung hat ein Arbeitsblatt, um An-und Abwesenheiten zu planen. Alles wird dabei auf ein extra Arbeitsblatt zusammen dargestellt. Nun versuche ich die An-und Abwesenheit auf Arbeitsblättern darzustellen. Mein bisheriger Befehl funktioniert grundsätzlich fehlerfrei. Hier mein Befehl:

Private Sub Worksheet_Activate()

Range("A6:W48").Select
Selection.ClearContents

Dim letzteZeile, i, w, x As Integer
Dim r As Range
Dim intDatum As Integer

Set r = Sheets("Dienstplaner").Cells.Find(Date)

intDatum = r.Column 'aktuelles Tagesdatum wird gesucht

letzteZeile = Worksheets("Dienstplaner").Cells(Rows.Count, 2).End(xlUp).Row
'MsgBox letzteZeile

For i = 31 To 36 'Bereichssuche Mitarbeiter Trupp

Select Case Worksheets("Dienstplaner").Cells(i, intDatum).Value
Case "F", "M", "S", "KS ", "A1", "A2", "E1", "E2":
x = Worksheets("Tagesstärke").Cells(Rows.Count, 2).End(xlUp).Row
Worksheets("Tagesstärke").Cells(x + 1, 2) Sheets_ "Dienstplaner").Cells(i, 2).Value

Case Else:
'MsgBox "nicht zugeteilt"

End Select

Next i

For i = 54 To 81 'Bereichssuche Mitarbeiter Zug 1

Select Case Worksheets("Dienstplaner").Cells(i, intDatum).Value
Case "F", "M", "S", "KS ", "A1", "A2", "E1", "E2":
x = Worksheets("Tagesstärke").Cells(Rows.Count, 8).End(xlUp).Row
Worksheets("Tagesstärke").Cells(x + 1, 8) = Sheets("Dienstplaner").Cells(i, 2).Value

Case Else:
'MsgBox "nicht zugeteilt"

End Select

Next i

End Sub

Problem daran, er sucht immer nach dem aktuellem Datum. Zur Planung möchte ich aber ein Datum vorgeben, sodass er nach diesem sucht.
Das habe ich mit dieser Variante versucht und bin gescheitert:

Private Sub Worksheet_Activate()

Dim letzteZeile, i, w, x As Integer
Dim Datum As Date
Dim r As Range

Set r = Sheets("Dienstplaner").Cells.Find(Date)
Datum = InputBox("Bitte Datum Eingeben" & vbNewLine & "Format:01.01.1900", "Abwesenheit erstellen")

letzteZeile = Worksheets("Dienstplaner").Cells(Rows.Count, 2).End(xlUp).Row

For i = 31 To 36 'Bereichssuche Mitarbeiter Trupp

Select Case Worksheets("Dienstplaner").Cells(i, Datum).Value
Case "F", "M", "S", "KS ", "A1", "A2", "E1", "E2":
x = Worksheets("Tagesstärke").Cells(Rows.Count, 2).End(xlUp).Row
Worksheets("Tagesstärke").Cells(x + 1, 2) Sheets_ "Dienstplaner").Cells(i, 2).Value

Case Else:
'MsgBox "nicht zugeteilt"

End Select

Next i
End Sub

Bei der ersten Select Case Zeile ist Feierabend.

Ich hoffe, dass ihr mir helfen könnt.

Gruß Micha.

P.S. Mein Problem habe ich in keinem anderen Forum geteilt.

:)

 

Moin!
Glaube ich Dir gerne! *wink.gif*
Was soll denn bei Cells(i, Datum) also z.B. Cells(31, "18.12.2018") herauskommen?

Gruß Ralf

 

Hallo Ralf

Das ist eine gute Frage. Durch die Eingabe des Datums in der Inputbox soll das gesuchte Datum übernommen werden. Meine Datumszeile ist waagerecht. Es soll also das gesuchte Datum gefunden werden und senkrecht die Arbeitsinformationen (also ob Spätdienst, Krank, Urlaub u.s.w., was dann ja mit select case zugeordnet wird).
Da bin ich wohl wieder auf dem Holzweg!

Mein Versuch war es ein vorgeschriebenes Datum zu finden und nicht immer nur das Aktuelle.

Gruß Micha.

Mir ist bewusst, dass meine Befehle sicherlich auch kürzer gehen, aber dafür bin ich leider ein Laie. Versuche aber immer das Beste aus meinen geringen Kenntnissen herauszuholen.

 

Du hast doch in Deinem funktionierenden oberen Code folgendes stehen:
Code:

also so:
Code:

 

Ich habe das jetzt mal in meine Testdatei eingepflegt, bevor ich den funktionierenden Befehl für das heutige Datum in den Sand setze.

Sub Kraefte()

Dim letzteZeile, i, w, x As Integer
Dim Datum As Date
Dim r As Range

Datum = InputBox("Bitte Datum Eingeben" & vbNewLine & "Format:01.01.1900", "Abwesenheit erstellen")
Set r = Sheets("Zug 1").Cells.Find(Date)

'Inhalt wird aus der Inputbox in das Feld eingetragen
'Worksheets("Abwesenheit").Range("E3").Value = Datum (später wieder einfügen)

letzteZeile = Worksheets("Zug 1").Cells(Rows.Count, 1).End(xlUp).Row

For i = 8 To 52 'Bereichssuche

Select Case Worksheets("Zug 1").Cells(i, Date).Value
Case "F", "M", "S", "A1", "A2", "E1", "E2":
x = Worksheets("Anwesenheit").Cells(Rows.Count, 6).End(xlUp).Row
Worksheets("Anwesenheit").Cells(x + 1, 6) = Sheets("Zug 1").Cells(i, 1).Value
Worksheets("Anwesenheit").Select

w = w + 1 ' bis hier passt es

Case Else:
'MsgBox "nicht zugeteilt"

End Select

Next i
Du schüttelst bestimmt gleich den Kopf :-)

 

Hey Ralf

dein Hinweis hat mir die Erleuchtung gebracht.

Habe noch etwas eingepflegt.

Datum = InputBox("Bitte Datum Eingeben" & vbNewLine & "Format:01.01.1900", "Abwesenheit erstellen")
Set r = Sheets("Zug 1").Cells.Find(Datum)
Datum = r.Column

Durch das Schreiben von "Datum = r.Column" läuft der Befehl durch und macht fast genau das, was er soll.

jetzt hab ich ein neues Problem :-(

Vielen Dank

 

(da ich zwischenzeitlich den Kopf geschüttelt habe *wink.gif*)
Prima, dass du es hinbekommen hast!

 

Ich habe den Befehl jetzt einmal in die Richtige Datei eingepflegt

Private Sub Worksheet_Activate()

Range("B6:X48").Select
Selection.ClearContents

Dim letzteZeile, i, w, x As Integer
Dim r As Range
Dim Datum As Date

Datum = InputBox("Bitte Datum eingeben" & vbNewLine & "Format: 12.06.2012", "Tageststärke erstellen")
Set r = Sheets("Dienstplaner").Cells.Find(Datum)
Datum = r.Column 'aktuelles Tagesdatum wird gesucht

Worksheets("Tagesstärke").Range("B2").Value = Datum

letzteZeile = Worksheets("Dienstplaner").Cells(Rows.Count, 2).End(xlUp).Row


For i = 31 To 36 'Bereichssuche Mitarbeiter Trupp

Select Case Worksheets("Dienstplaner").Cells(i, Datum).Value
Case "F", "M", "S", "KS ", "A1", "A2", "E1", "E2":
x = Worksheets("Tagesstärke").Cells(Rows.Count, 2).End(xlUp).Row
Worksheets("Tagesstärke").Cells(x + 1, 2) = Sheets("Dienstplaner").Cells(i, 2).Value

Case Else:
'MsgBox "nicht zugeteilt"

End Select

Next i

Ist nur ein Teil vom Ganzen, wiederholt sich aber


Bei
Worksheets("Tagesstärke").Range("B2").Value = Datum wird mir ein Datum im Dezember 1900 ausgeworfen.

Wo liegt da der Fehler?

Gruß Micha

 

Hallo

warum Datum = r.Column

 

Hey Tom

Danke, dass du dich meinem Befehl gewidmet hast.

durch Datum = r.column läuft der Befehl durch. Mein Dienstplaner ist waagerecht aufgebaut. Mitarbeiter untereinander, Tagesfolge von links nach rechts aufbauend. Somit muss das Datum Waagerecht gesucht werden und befindet sich nur in einer Zeile. Würde ich die die Suche fest auf eine Zeile fixieren, muss ich beim Zufügen einer Zeile wieder neu in den Befehl müssen. Deshalb habe ich mich für r.column entschieden.

Worksheets("Tagesstärke").Range("B2").value =Datum sollte eigentlich das eingetragene Datum aus der Inputbox sein.

Gruß Micha

 

Hi

schau mal ob es so passt

Code:

 

Hey Tom

hat wunderbar funktioniert. Einwandfrei.
Somit bin ich einen riesen Schritt weiter gekommen.

Danke an alle

Gruß Micha