Code is traag en weet niet waarom

[mlaurense]

Help...

Ik heb een probleempje...
Ik ben bezig met een urengregistratiesysteempje op basis van een standaardinvulformulier. In sommige gevallen moeten mensen ingevulde gegevens weer op kunnen roepen. Daarvoor heb ik een knop gemaakt. Vervolgens krijg je een invulveld waarin je eerst een persoon kunt kiezen en vervolgens een een weeknummer.

Als je op OK klikt worden de gegevens uit een "database"worksheet opgehaald en teruggeplaatst in de het standaardinvulformulier.
Alleen op 1 stukje code blijft mijn systeempje hangen. Het duurt 10 tot 20 seconden voordat hij doorgaat.

Het stukje code waar volgens mij het probleem in zit is:

'kopieren naar manuren invoer
Sub verplaats_temp()
Dim lngCounter As Long
Dim bytcounter As Byte
Dim arrValues As Variant

With Sheets("temp")
    arrValues = .Range("a2:s" & .UsedRange.Rows.Count)
End With

For lngCounter = 1 To UBound(arrValues)
    On Error Resume Next
    For bytcounter = 1 To UBound(arrValues, 2)
        With Sheets("manuren invoer")
            .Cells(arrValues(lngCounter, 1), bytcounter) = arrValues(lngCounter, bytcounter)
        End With
    Next bytcounter
Next lngCounter
End Sub

Deze code staat in "Module1"

Kan iemand mij helpen om de "hickup" van 10 a 20 seconden te helpen oplossen????

Ik heb een documentje met het probleempje openbaar gemaakt op:
http://docs.google.com/uc?export=do...5NGRhYTYtODQ3NS00MWE0LWExYzYtYzQ0ZjY5MTAwZDk1

Alvast bedankt,

Michiel

 

[snb]

Heb je enig idee wat de code doet ?

deze doet exact hetzelfde:

Sub verplaats_temp()
  With Sheets("temp").usedrange.offset(1)
    sheets("manuren invoer").cells(1,1).resize(.rows.count,.columns.count)=.Value
  End With
End Sub

 

[mlaurense]

Beste SNB,

Helaas doet jou code niet exact hetzelfde. De code die ik gebruik zorgt ervoor dat gegevens ook op de juiste regel komen te staan. De code van jou begin bij regel 1 en vult de andere regels daaronder in.

De code die ik heb gebruikt, is het resultaat van een vraag die ik al eerder heb gesteld, namelijk:

http://www.helpmij.nl/forum/showthread.php/516114-verplaats-een-rij-nav-een-nummer-in-een-cel

Hopelijk verduidelijkt dit het een en ander.

gr.
Michiel

 

[Interface]

ik denk niet dat het in deze code zit

volgens mij zit het neit echt hier in...

Knippert het beeld?

zo ja,

gebruik:

application.screenupdating = false aan het begin van je procedure en application.screenupdating = true aan het eind van je procedure

 

[mlaurense]

toch wel....

Beste Interface,

Heb je het excel documentje gedownload (dat staat in het eerste bericht)? Dan zie je dat hij ergens op code blijft hangen. De CPU gaat naar 100% en na ongeveer 10 seconden loopt hij door zoals ik het bedoeld had.

Ik begrijp alleen niet wat er gebeurt in die 10 seconden....

 

[Mark xl]

Beste mlaurens,

Ik heb je bestandje even gekeken en getest.

Bij mij is ArrValues een array van 65535 rijen bij 19 kolommen, misschien dat het daardoor komt dat je macro trager loopt

Verder is het handig om zoveel mogelijk variabelen te declareren(in je gehele werkmap).
Gebruik van variabelen geeft mij meestal betere performance, en bij het declareren van Eigenschappen krijg je bij het gebruik ervan in je code direct een aantal suggesties voor je methoden!

Probeer ook On Error Resume next te vermijden, meestal kun je het makkelijk omzeilen, bijvoorbeeld met een simpele Check of de het matrixveld leeg is (die geeft namelijk een error op je range object)

Probeer eens of deze kleine verandering je verder helpt.

Sub verplaats_temp()
Dim lngCounter As Long
Dim bytcounter As Byte
Dim arrValues As Variant
Dim lngRows As Long
Dim lngRow As Long

With Sheets("temp")
    lngRows = .Range("A2", .Range("A65535").End(xlUp)).Rows.Count
    arrValues = .Range("a2:s" & lngRows)
End With

For lngCounter = 1 To UBound(arrValues)
    If arrValues(lngCounter, 1) <> Empty Then
        
        lngRow = arrValues(lngCounter, 1)
        For bytcounter = 1 To UBound(arrValues, 2)
            
            With Sheets("manuren invoer")
                .Cells(lngRow, bytcounter) = arrValues(lngCounter, bytcounter)
            End With
        
        Next bytcounter
    End If
Next lngCounter
End Sub

Mark.

 

[Warme bakkertje]

Controleer eerst met ctrl+end waar je laatst gebruikte cel zich bevindt. Als dit ver onder je laatste regel gegevens is selecteer dan alle rijen onder je gegevens, rechtsklik en selecteer verwijderen, sla je bestand op, sluiten en heropenen. Nu zou je met UsedRange het werkelijke aantal rijen moeten krijgen ipv je hele werkblad