Goedemiddag,
Ik gebruik al sinds een tijdje succesvol een mooie macro maar opeens krijg ik nu een foutmelding zonder dat er iets is gewijzigd.
Nu krijg ik een foutmelding waar ik echt niet uitkomt. Onderstaande is de macro. dikgedrukt is waar die op vastloopt. Wie kan mij helpen?
Option Explicit
Sub HetLoopje()
Productiviteit Sheets("orderpicken").Range("A1").CurrentRegion, 20, 18, 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: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
Ik gebruik al sinds een tijdje succesvol een mooie macro maar opeens krijg ik nu een foutmelding zonder dat er iets is gewijzigd.
Nu krijg ik een foutmelding waar ik echt niet uitkomt. Onderstaande is de macro. dikgedrukt is waar die op vastloopt. Wie kan mij helpen?
Option Explicit
Sub HetLoopje()
Productiviteit Sheets("orderpicken").Range("A1").CurrentRegion, 20, 18, 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: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
