Doorlooptijd Macro Verbeteren

[Bastiaansen]

Hoi forumleden!
Ik had een tijd terug een Macro gekregen om de minimumwerktijd te kunnen berekenen.
De macro is echter nog niet exact wat ik zocht en daarom een (klein) vraagje: hoe verander ik de code om in plaats van 8, 25 klusjes te kunnen analyseren?

Uitleg:
In het excel bestand staan 3 werknemers (verticaal) en 25 klusjes (horizontaal) en de tijd die de werknemers over de klusjes doen. De code dient ervoor de kortste tijd te berekenen. De code is op dit moment nog ingesteld op 8 klusjes voor de werknemers, maar ik zou hier graag 25 klusjes van maken. Wat ik geprobeerd heb is om alle getallen '8' te veranderen in '25' maar dan komt 'Fout 6 tijdens uitvoering: Overloop' in beeld. De foutopsporing geeft aan dat de regel 'ReDim ZoekArray((Werknemers ^ Klusjes), Klusjes)' foutief is, ik zie echter geen fout en weet dus ook niet hoe ik het probleem oplos.


Alvast bedankt!

Bekijk bijlage DooloopTijd Edit 4.2.xlsmBekijk bijlage DooloopTijd Edit 4.2.xlsm

 

[OctaFish]

Je kunt niet meer dan 16 dimensies opgeven, en jij probeert er 25. Dus de gebruikte techniek gaat zo niet werken.

 

[Warme bakkertje]

Sub tst()
    sn = Sheets("Blad1").Cells(1).CurrentRegion.Value
    smallest = 10000: whatrow = vbNullString
    For i = 2 To UBound(sn, 2)
        For ii = 2 To UBound(sn)
            If sn(ii, i) < smallest Then smallest = sn(ii, i): whatrow = ii
            sn(ii, i) = vbNullString
        Next
        sn(whatrow, i) = smallest
        smallest = 10000: whatrow = vbNullString
    Next
    Sheets("Blad1").Cells(20, 1).Resize(UBound(sn), UBound(sn, 2)) = sn
End Sub

 

[Bastiaansen]

Sub tst()
    sn = Sheets("Blad1").Cells(1).CurrentRegion.Value
    smallest = 10000: whatrow = vbNullString
    For i = 2 To UBound(sn, 2)
        For ii = 2 To UBound(sn)
            If sn(ii, i) < smallest Then smallest = sn(ii, i): whatrow = ii
            sn(ii, i) = vbNullString
        Next
        sn(whatrow, i) = smallest
        smallest = 10000: whatrow = vbNullString
    Next
    Sheets("Blad1").Cells(20, 1).Resize(UBound(sn), UBound(sn, 2)) = sn
End Sub

Bedankt Bakkertje.
Ik heb de code er nu in gezet, ik wist niet precies waar ik de code moest plaatsen maar goed, hij berekende iets voor 25 klusjes waar ik opzich al blij mee ben.
Nu is het probleem als volgt: de code voert niet meer uit wat oorspronkelijk de bedoeling was. De kortste tijd wordt niet meer berekent (er komt een foutieve kortste tijd).
En de sommige klusjes worden nu uitgevoerd door meerdere personen tegelijk wat niet de bedoeling is (zie foto)

 

[Warme bakkertje]

Waarom plak jij mijn code tussen die andere code ???????:shocked:
De code voert wel degelijk uit wat oorspronkelijk de bedoeling was, jij springt er niet correct mee om.
Dit is een standalone code, geen samenvoegcode.
Maak een nieuwe module aan en plak daar mijn code eens in en draai dan nog maar eens.

 

[Bastiaansen]

Waarom plak jij mijn code tussen die andere code ???????:shocked:
De code voert wel degelijk uit wat oorspronkelijk de bedoeling was, jij springt er niet correct mee om.
Dit is een standalone code, geen samenvoegcode.
Maak een nieuwe module aan en plak daar mijn code eens in en draai dan nog maar eens.

Sorry Bakkertje ik heb hier vrijwel geen verstand van en probeer wat ik kan.
Ik heb de code hier en daar geplaatst maar krijg het maar niet voor mekaar
Het spijt me enorm.

 

[Warme bakkertje]

Zie bijlage.