HalloWie du richtig erkannt hast, nehme ich für jeden tag eine Spalte und für die einzelnen Benutzer je eine Zeile! Es wird alles ausgefüllt!
Die Funktionen hängen alle stark zusammen, darum ein "bisschen" unübersichtlich!
Mein Problem ist einfach da auf einem Blatt, die Tagen vom 1.1.03-30.4.03, 1.5.03-31.8.03 und vom 1.9.03-31.12.03 gehen, wird das darstellen sehr kompliziert, wenn der Bereich mehr als 1 Sheet verwendet!!
Hier der Code, einfach vereinfacht!!
Ausgangsfunktion!
EndNA
Werte aus Textfiles!
frmNA.txtE1.Text = Name
frmNA.txtTimeAS.Text, frmNA.txtTimeAE.Text = Anfangs und End Datum
Call NameSearch(frmNA.txtE1.Text)
Call DateSearch(frmNA.txtTimeAS.Text, frmNA.txtTimeAE.Text)
Public Sub NameSearch(strUser1 As String)
Dim intPosUsers, intAbbruch, intZaehler As Integer
'"Wird 3mal aufgerufen für jedes Blatt"
Sheets("Jan-April 03").Select
intPosUsers = Range("Users").Column
intZaehler = 2
intAbbruch = 0
Do While intAbbruch < 10
If Cells(intZaehler, intPosUsers) = strUser1 Then
intPosUser = intZaehler
check = True
Exit Sub
End If
If Cells(intZaehler, intPosUsers) = "" Then intAbbruch = intAbbruch + 1
intZaehler = intZaehler + 1
If Cells(intZaehler, intPosUsers) <> "" Then intAbbruch = 0
Loop
Public Sub DateSearch(strDate1, strDate2 As Date)
Dim intPosDate, intAbbruch, intZaehler As Integer
Dim datDate As Date
Dim intPosSD, intPosED As Integer
'" Wird auch 3mal aufgerufen für jedes Blatt"
Sheets("Jan-April 03").Select
intPosDate = Range("Day").Row
intZaehler = 2
intAbbruch = 0
Do While intAbbruch < 10
datDate = Cells(intPosDate, intZaehler)
If datDate = strDate1 Then
intPosSD = intZaehler
Do While intAbbruch < 10
datDate = Cells(intPosDate, intZaehler)
If datDate = strDate2 Then
intPosED = intZaehler
If strChoice = 0 Then
Call paintNE(intPosUser, intPosSD, intPosED)
Else
Call paintNA(intPosUser, intPosSD, intPosED)
End If
Exit Sub
End If
If datDate = 0 Then intAbbruch = intAbbruch + 1
intZaehler = intZaehler + 1
If datDate <> 0 Then intAbbruch = 0
Loop
End If
If datDate = 0 Then intAbbruch = intAbbruch + 1
intZaehler = intZaehler + 1
If datDate <> 0 Then intAbbruch = 0
Loop
Function paintNA(intUser, intSD, intED As Integer)
Range(Cells(intUser, intSD), Cells(intUser, intED)).Select
With Selection.Interior
.ColorIndex = 10
.Pattern = xlSolid
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = True
End With
ActiveCell.FormulaR1C1 = frmNA.txtAbsence.Text & " " & frmNA.txtTA.Text
End Function