20 regneark samlet i en pivot?

Kunne man ikke forestille sig en skabelon, der kan anvendes af den enkelte medarbejder til indtastning af data. Ved lukning af filen overføres data til en central xls.fil.

Omregning af en dato til ugedag er intet problem.

Hvor kommer pivot-tabellen ind i billedet?

Umiddelbart lyder sådan en skabelon ikke som nogen dum idé. Jeg kan fortælle, at i dag foregår det på følgende måde.

For hver dag udfylder manden en timeseddel, skriver på denne, hvornår han kom og hvornår han gik, samt hvilke projekter han har lavet og timeforbruget ud for disse. Derefter samles disse ark i en oversigt over hver medarbejder, så bogholderen ved, hvor meget løn, hun skal udbetale. MEN vi ønsker at udvide funktionerne, så vi kan kontrollere, om et projekts timeforbrug svarer til det estimerede, og det er her pivot-tabellen kommer ind i billedet.

I fortsættelse af mit indlæg kan jeg til at den nævnte opdatering kunne udføres på såvel den enkelte medarbejder som på projekter.

Hvor meget "automatik" anvender I p.t.?
Hvor stor datakontrol er der i forbindelse med medarbejdernes registrering?

Medarbejdernes timesedler tjekkes og kontrolleres af produktionschefen, hvorefter de tastes ind i et regneark. For at spare tid, er det vores ønske, at medarbejderen selv taster sine data ind, og at det således her kan kontrolleres, inden det overføres til lønudbetaling.

Jeg forstår ikke det du skrev: "I fortsættelse af mit indlæg kan jeg til at den nævnte opdatering kunne udføres på såvel den enkelte medarbejder som på projekter."

Jeg mener følgende:

Når medarbejderen har indtastet sin data - så kan disse data automatisk opdateres på medarbejderens "konto" og på de anførte projekters "konto".

Ved "automatisk" - mener via VBA (Visual Basic for Applications - programmeringssproget i office-pakken).

Ja, det er præcis det jeg ønsker, der skal ske

Hvordan kommer vi så videre?
Foreligger der nogle skitser - eks. på indtastning / "de nævnte konti" m.v.
Forventes en total-løsning - evt. baseret på en model, der så kan tilpasses?

Evt. yderligere info kan sendes direkte til pb@supertekst-it.dk

Ja, sender dig en mail...

Rem Samling af ugesedler
Rem ====================
Dim hovedMappe
Const slutRække = "I alt pr. uge:"

Dim rækNr, aktuelleDato As Date
Private Sub workbook_activate()
Rem opsætning af hovedmappe
    hovedMappe = ActiveWorkbook.Path
    If Right(hovedMappe, 1) <> "\" Then
        hovedMappe = hovedMappe + "\"
    End If
   
    rækNr = 1

Rem Slet bestående indhold
    Cells.Delete
   
Rem Hent filer fra medarbejder-mapperne
    søgiMappe hovedMappe + "Ugesedler"
   
Rem Autotilpas kolonner
    Columns.AutoFit
   
    MsgBox ("Overførsel af ugesedler er udført")
End Sub
Private Function søgiMappe(mappe)
Dim fs, f, f1, fc, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(mappe)
    Set fc = f.Files
    For Each f1 In fc
        hentData mappe, f1.Name
    Next
End Function
Private Sub hentData(mappe, filNavn)
Dim xls As Object
    Set xls = CreateObject("Excel.Application")
    With xls
        .Workbooks.Open mappe + "\" + filNavn
        behandlingAfFil xls
    End With
   
Rem Luk filen
    xls.Quit
    Set xls = Nothing
End Sub
Private Sub behandlingAfFil(xls As Object)
Dim antalRæk
    With xls
        If rækNr = 1 Then
            sætOverskrifter xls
            rækNr = rækNr + 1
        End If
   
        antalRæk = .ActiveCell.SpecialCells(xlLastCell).Row    'brutto-rækker på ark
        For ræk = 7 To antalRæk
Rem Test om I alt-række er nået
            If .Cells(ræk, 1) = slutRække Then
                Exit Sub
            End If
           
            If testTomrække(xls, ræk) = False Then
                overførRække xls, ræk
                rækNr = rækNr + 1
            End If
        Next ræk
    End With
End Sub
Private Sub sætOverskrifter(xls As Object)
    Cells(1, 1) = "Dag"                    'ugedag
   
    For k = 1 To 8
        Cells(1, k + 1) = xls.Cells(6, k)
    Next k
End Sub
Private Function testTomrække(xls As Object, ræk)
    For k = 1 To 8
Rem Skip, hvis "Empty" eller blank
        If xls.Cells(ræk, k) <> "" And xls.Cells(ræk, k) <> " " Then
            testTomrække = False
            Exit Function
        End If
    Next k
   
    testTomrække = True
End Function
Private Sub overførRække(xls As Object, ræk)
    For k = 1 To 8
        With xls
            If k = 1 Then
Rem Er dato udfyldt
                If .Cells(ræk, 1) <> "" Then
                    aktuelleDato = redigerDato(.Cells(ræk, 1))
                End If
                Cells(rækNr, 1) = findUgedag(aktuelleDato)
                Cells(rækNr, 2) = aktuelleDato
            Else
                Cells(rækNr, k + 1) = .Cells(ræk, k)
            End If
        End With
    Next k
End Sub
Private Function redigerDato(dato)
Dim p, rDato As Date
    p = InStr(dato, ".")
    If p > 0 Then
        dg = Left(dato, p - 1)
        md = Mid(dato, p + 1)
        rDato = dg + "-" + md + "-" + "2006"        'TEST-ÅR
        redigerDato = rDato
    End If
End Function
Private Function findUgedag(dato)
Dim uDagNavne As Variant
    uDagNavne = Array("", "Man", "Tir", "Ons", "Tor", "Fre", "Lør", "Søn")
    findUgedag = uDagNavne(DatePart("w", dato, 2, 2))
End Function

lukketid???