Goedemiddag,
Zouden jullie mij kunnen helpen?
Met behulp van dit forum heb ik een tijd geleden bijgevoegd bestand in elkaar gedraaid. Hier zit een macro in die op persoonsniveau het aantal regels optelt.
Nu wil ik met tabblad 'trucken en invakken' niks wijzigen. maar bij de andere tabbladen wel.
Daar wordt nu in tabblad 'productiviteit' onder 'aantal scans' het aantal regels opgeteld per persoon.
maar bij die andere 3 onderwerpen wil ik graag het totaal aan stuks bij elkaar optellen dmv 'som'. onder het kopje 'aantal stuks'. Daar wordt nu ook het aantal regels opgeteld.
Maar zover ik het kan zien moet dan heel de macro op zijn kop.
iemand mij hiermee helpen?
Zouden jullie mij kunnen helpen?
Met behulp van dit forum heb ik een tijd geleden bijgevoegd bestand in elkaar gedraaid. Hier zit een macro in die op persoonsniveau het aantal regels optelt.
Nu wil ik met tabblad 'trucken en invakken' niks wijzigen. maar bij de andere tabbladen wel.
Daar wordt nu in tabblad 'productiviteit' onder 'aantal scans' het aantal regels opgeteld per persoon.
maar bij die andere 3 onderwerpen wil ik graag het totaal aan stuks bij elkaar optellen dmv 'som'. onder het kopje 'aantal stuks'. Daar wordt nu ook het aantal regels opgeteld.
Maar zover ik het kan zien moet dan heel de macro op zijn kop.
Code:
Sub HetLoopje()
Productiviteit Sheets("orderpicken").Range("A1").CurrentRegion, 21, 17, Range("A3:G32")
Productiviteit Sheets("inpakken").Range("A1").CurrentRegion, 1, 6, Range("A36:G65")
Productiviteit Sheets("Trucken-Invakken").Range("A1").CurrentRegion, 14, 9, Range("A69:G100")
Productiviteit Sheets("AG sorteren").Range("A1").CurrentRegion, 14, 9, Range("A104:G120")
End Sub
Sub Productiviteit(MijnGegevens As Range, KolNaam As Integer, KolTijd As Integer, Uitvoer As Range)
Dim a, i&, it, dTijd As Double, splits, Pers$
a = MijnGegevens.Value 'inlezen gegevens
With CreateObject("System.Collections.Arraylist") 'om straks oplopend te sorteren
For i = 2 To UBound(a)
Select Case VarType(a(i, KolTijd)) 'kijk naar je tijd
Case vbString 'is het een string
splits = Split(Replace(a(i, KolTijd), "-", " ")) 'vervang "-" door een spatie en verknip op die spaties
If UBound(splits) = 3 Then '4 knipsels
a(i, KolTijd) = DateSerial(splits(2), splits(1), splits(0)) + TimeValue(splits(3)) 'je tijdstip met datum
Else
a(i, KolTijd) = TimeValue(splits(0)) 'je tijdstip
End If
Case vbDate, vbDouble 'het is al een date of een double
Case Else: MsgBox "??? vbDate"
End Select
dTijd = a(i, KolTijd) 'maak er een double van
.Add Join$(Array(Format(dTijd, "00000.0000000"), a(i, KolNaam)), Chr(2)) 'naar arraylist schrijven
Next
.Sort 'sorteren
a = .toarray() 'naar array schrijven
If Not IsArray(a) Then MsgBox "geen gegevens", vbCritical: Exit Sub
End With
With CreateObject("scripting.dictionary")
.comparemode = 1
For i = LBound(a) To UBound(a)
splits = Split(a(i), Chr(2))
dTijd = splits(0)
Pers = splits(1)
it = .Item(Pers) 'kijk naar die persoon in de dictionary
If VarType(it) = vbEmpty Then 'persoon bestond nog niet in dictionary
.Item(Pers) = Array(Pers, dTijd, dTijd, 0, 1, 0, 0) 'array met naam, Start, Einde, onderbrekingen,aantal scans, gewerkte tijd,Productiviteit
Else
If dTijd - it(2) > TimeSerial(0, 30, 0) Then it(3) = it(3) + dTijd - it(2) 'tijd tov vorig gegeven bijtellen indien tussentijd>30 min
it(4) = it(4) + 1 'scan + 1
it(2) = dTijd 'laatste tijd
.Item(Pers) = it 'terugschrijven naar dictionary
End If
Next
If .Count = 1 Then .Item("") = Array("", "", "", "", "", "", "")
a = ""
If .Count Then
a = Application.Transpose(Application.Transpose(.items)) 'uitlezen items van dictionary
For i = 1 To UBound(a) 'alle personen aflopen
If Len(a(i, 1)) Then
a(i, 6) = a(i, 3) - a(i, 2) - a(i, 4) 'gewerkte tijd
If a(i, 5) > 1 Then a(i, 7) = a(i, 5) / (a(i, 6) + 0.0000000001) / 24 'productiviteit
End If
Next
End If
End With
With Uitvoer 'naar hier schrijven
.ClearContents
If IsArray(a) Then .Resize(WorksheetFunction.Min(.Rows.Count, UBound(a)), UBound(a, 2)).Value = a 'de gegevens
End With
End Sub
Laatst bewerkt:
