Routine versimpelen

Status
Niet open voor verdere reacties.

Plannert

Gebruiker
Lid geworden
2 dec 2011
Berichten
34
Helpmij,

Ik heb het volgende stukje code geschreven:

Code:
Sub Planning2()

Dim i As Integer
Dim a As Integer
Dim x As Integer

Range("M7:W11").Clear

For i = 7 To 100
    For a = 13 To 100
    If Cells(i, 3) = Cells(5, a) Then
        For x = 1 To (Cells(i, 4) - Cells(i, 3))
        Cells(i, a + x) = (Cells(i, 11) / (Cells(i, 4) - Cells(i, 3)))
        Next x
    Else
    End If
    Next a
Next i
End Sub

Het werkt voor wat ik wil doen, echter denk ik dat het makkelijker kan en met name efficiënter, alleen daar ontbreekt mij de kennis. Wat doet het stukje code? Hij kijkt naar een start- en einddatum en op basis van een bepaalde hoeveelheid uren verdeeld hij deze liniear over deze periode. Deze uren worden in de tijd, dmv een weekcode (bv 201301), weggeschreven. Hoe ik het nu gedaan heb wordt er 100 *100 keer een routine gedraaid, ik wil dat hij start bij de startdatum en stopt bij de einddatum en dat de code dan weer verder gaat naar de volgende regel.

Ik hoop dat het duidelijk is wat ik bedoel.

Alvast bedankt,

Patrick
 
Ik zou het niet veel verder aanpassen. De performance is best ok. Je kunt met lookup's/lookahead gaan werken maar met deze beperkte bereiken ga je daar niet veel winst uit halen (of zelfs vertragen)
 
Oke, in ieder geval leuk dat het OK is :).

Ik zou toch graag de tijd van het script verkorten, nu is het ongeveer 5 minuten bezig. Of is dit normaal bij een dergelijk script?
 
Dat hoort echt niet. Het script zou ongeveer 10 seconden moeten duren. Als het script werkelijk zo lang duurt komt dat waarschijnlijk door recalculate en screenupdating.

probeer eens:

Code:
application.screenupdating = false
application.calculation = xlmanual

... rest van je huidige code ...

application.screenupdating = true
application.calculation = xlCalculationAutomatic
 
Vereenvoudiging:
De "Else" kan eruit :p
 
Plaats eens een voorbeeldbestand; waar staat de startdatum, waar staat de einddatum ?
 
Ik ben zelf verder aan het proberen geslagen en ben nu zover:

Code:
Sub Planning2()

Application.ScreenUpdating = False
Application.Calculation = xlManual


Dim i As Integer
Dim a As Integer
Dim x As Integer
Dim LeadTime As String
Dim Hours As String

Range("M7:W11").Clear
mycount = Application.CountA(Range("A:A")) + 5

For i = 7 To mycount

LeadTime = (Cells(i, 4) - Cells(i, 3))
Hours = Cells(i, 11)
myvaluestart = Application.Match(CLng(Cells(i, 3)), Rows(5), 0)
myvalueend = Application.Match(CLng(Cells(i, 4)), Rows(5), 0)
    
    If Cells(i, 3) = "" Then
    Else
        For a = myvaluestart To myvalueend
        If Cells(i, 3) = Cells(5, a) Then
            For x = 0 To LeadTime
            Cells(i, a + x) = Round((Hours / (LeadTime + 1)), 0)
            Next x
        Else
        End If
        Next a
    End If
Next i

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub

Dit voldoet nu, eventuele feedback blijft welkom. Mijn vragen zijn in ieder geval opgelost :).
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan