somproduct loopt traag

[Spiesse]

Beste,

dagelijks hou ik me bezig met de invoer van gegevens in een tabel...

aan de hand van een servertabel moet ik de uren berekenen van de orders die afgewerkt zijn. hiervoor gebruik ik de formule somproduct. dit lukt allemaal. enige wat ik ondervind is dat de berekening (nu al een tabel van net geen 1000 regels) er heel lang over doet om te berekenen.

Bestaat er een vlottere manier om dit te laten berekenen? Ik heb al geprobeerd met som(als...) in matrix maar heb de indruk dat dit even lang duurt...

kunnen 2 tabellen samengevoegd worden in een draaitabel? op die manier zou ik ook de uren en dergelijke kunnen weergeven...

ik ben benieuwd! helaas kan ik wel geen bestand mee uploaden...
groeten
spiesse

 

[MauriceSmit]

Sumproduct is inderdaad een formule van het type 'volatile' (in Excel terminologie). En ik heb ervaring met het feit dat ze erg lanzaam kunnen worden bij grote hoeveelheden data. Als je in 2007 (of hoger werkt) kun je eens kijken naar de sommen.als (sumiffs) variant, indien je een sumif hebt met meerdere criteria. Sumifs is vele malen sneller.

Om een draaitabel te gebruiken zul je een macro moeten schrijven die de twee data tabellen samenvoegd; draaitabellen kunnen helaas niet omgaan met verschillende sources.

*excuus voor de hoeveelheid Engelse termen

 

[Spiesse]

hey maurice,
bedankt voor de info. ik heb ondertussen es geprobeerd met som(als... en die komt overeen met somproduct. of bedoel je som.als()

mss een kleine uitbreiding: in mijn invoerblad gebruik ik vert.zoeken om 4 kolommen te vullen met gegevens... hier heb ik al over de 14000 regels ingevoerd... kan deze formule vlotter? of via een macro?

thx in advance (om ook es engels te gebruiken)
spiesse

 

[Spiesse]

'uren omzetten
If Intersect(Target, Range("i36:j20000")) Is Nothing Then GoTo Einde
If IsEmpty(Target) Then GoTo Einde

If Hour(Target.Value) <> 0 Or Minute(Target.Value) <> 0 Then GoTo Einde
Application.EnableEvents = False
If Int(Target.Value / 100) < 0.1 Then
Target = "00:" & Target.Value
Else
Target = Int(Target.Value / 100) & ":" & Right(Target.Value, 2)
End If
Application.EnableEvents = True

Einde:
ActiveSheet.Calculate


End Sub

deze code heeft iemand geschreven om 4 cijfers na elkaar als uurnotatie te zien... kan het zijn dat activesheet.calculate de boel ophoudt hier?
is dit eigenlijk wel nodig? ik bedoel: in de laatste kolom van mijn tabel doe ik zelf ook een berekening

ALS.FOUT(((J16407-I16407)*24)-(Pause(I16407;J16407;PauseTabel)*24);"")

. ben ik juist als deze macro en deze formule elkaar tegenhouden?

 

[MauriceSmit]

Deze code kan inderdaad voor behoorlijk wat vertraging zorgen; simpelweg staat er dat voor iedere keer dat hij in de sub komt, hij het tabblad gaat doorrekenen.
Stel dat dit op het worksheet_change of worsksheet_selection_change event is, dan heb je een behoorlijke overhead te pakken.

Wellicht te proberen om hem tijdelijk uit te quoten (dus de gehele sub te voorzien van '-tekens) en te kijken wat het resultaat is.

 

[Spiesse]

ik probeer
maar ik vermoed dat de :-tekens dan niet geplaatst zullen worden?

 

[MauriceSmit]

'If Intersect(Target, Range("i36:j20000")) Is Nothing Then GoTo Einde
'If IsEmpty(Target) Then GoTo Einde

'If Hour(Target.Value) <> 0 Or Minute(Target.Value) <> 0 Then GoTo Einde
'Application.EnableEvents = False
'If Int(Target.Value / 100) < 0.1 Then
'Target = "00:" & Target.Value
'Else
'Target = Int(Target.Value / 100) & ":" & Right(Target.Value, 2)
'End If
'Application.EnableEvents = True

'Einde:
'ActiveSheet.Calculate


'End Sub

zoiets ;-)

 

[Spiesse]

lol

kan ik bepaalde delen wel laten doorlopen?

 

[Spiesse]

'If Intersect(Target, Range("i36:j20000")) Is Nothing Then GoTo Einde
'If IsEmpty(Target) Then GoTo Einde

'If Hour(Target.Value) <> 0 Or Minute(Target.Value) <> 0 Then GoTo Einde
'Application.EnableEvents = False
'If Int(Target.Value / 100) < 0.1 Then
'Target = "00:" & Target.Value
'Else
'Target = Int(Target.Value / 100) & ":" & Right(Target.Value, 2)
'End If
'Application.EnableEvents = True

'Einde:
'ActiveSheet.Calculate


'End Sub

zoiets ;-)

dit zorgt ervoor dat de kolom waar de uitgerekende uren komen te staan op #naam komt...
ik zou dus een deel van de macro moeten kunnen inkorten of veranderen... dienen then goto EINDE is er me teveel aan

 

[Spiesse]

activesheet veranderen naar activecell of activerow verandert niet echt veel

ik heb hier geen flauw benul van hoe ik dit kan rapper doen lopen

 

[Warme bakkertje]

Al eens geprobeerd enkel de ActiveSheet.Calculate uit te schakelen zodat het werkblad niet steeds herberekend wordt?

 

[MauriceSmit]

en achter welk event hangt deze code? (Als het op worksheet_change is dan zorgt deze macro ervoor dat hij zichzelf aanroept)

 

[Spiesse]

warmebakkertje,
hoi

effe van thuis uit: als ik de activesheet.calculate ga uitschakelen met een ', gaat dit dan wel blijven gaan? eigenlijk is het de bedoeling dat enkel de laatst ingevulde regel berekend wordt van een tabel... niet de vorige 16000 regels dit vraagt heel veel van het bestand en de pc...

ik ga het morgen op het werk es testen...

@maurice: deze event hangt achter het blad van de invoer. het is een privatesub worksheet on interval of zoiets... morgen kan ik hier meer duidelijkheid over verschaffen vanop pc op bureau...

moesten jullie nog info hebben, ik ben bereikbaar
greets
spiesse

 

[MauriceSmit]

En een verfijning zoals deze? Ik probeer alleen de macro uit te voeren als de laatste cel van een door jouw opgegeven kolomnummer wordt gemuteerd. (Even uit mijn hoofd getikt, dus even nalopen of het klopt )

dim LastCell as range
set LastCell = activesheet.cells(activesheet.usedrange.rows.count, KOLOMNUMMER)
If [COLOR="red"]NOT [/COLOR]Intersect(Target, LastCell) Is Nothing then 
Application.EnableEvents = False
Application.Screenupdating = False
If Int(Target.Value / 100) < 0.1 Then
Target = "00:" & Target.Value
Else
Target = Int(Target.Value / 100) & ":" & Right(Target.Value, 2)
End If
Activesheet.calculate
Application.EnableEvents = True
Application.screenupdating = true
End Sub

 

[Spiesse]

maurice, waar moet deze neergepend worden? ergens ter vervanging van andere regels? of een nieuwe macro in het leven roepen?
ik ben continue bezig met dingen te bekijken... de ene moment heb ik het gevoel dat het vlotter loopt, de andere moment dan weer niet...
grrrr

spiesse

 

[Warme bakkertje]

Deze regels vervangen de huidige macro. Plaats deze in het event dat je nu gebruikt.
Vervang kolomnummer nog wel even door het cijfer dat de kolom vertegenwoordigt waarin je de waarde tikt.

 

[Spiesse]

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

'overslaan cellen
If Target.Column = 1 Then Target.Offset(0, 2).Select
If Target.Column = 3 Then Target.Offset(0, 6).Select
If Target.Column = 10 Then Target.Offset(0, 1).Select
If Target.Column = 10 Then Target.Offset(1, -9).Select

'uren omzetten
If Intersect(Target, Range("i36:j20000")) Is Nothing Then GoTo Einde
If IsEmpty(Target) Then GoTo Einde

If Hour(Target.Value) <> 0 Or Minute(Target.Value) <> 0 Then GoTo Einde
Application.EnableEvents = False
If Int(Target.Value / 100) < 0.1 Then
Target = "00:" & Target.Value
Else
Target = Int(Target.Value / 100) & ":" & Right(Target.Value, 2)
End If
Application.EnableEvents = True

Einde:
'ActiveSheet.Calculate

End Sub

dit is de volledige macro... waar precies moet ik de vervanging doorvoeren? het eerste deel is geschreven om bepaalde kolommen over te slaan via tab (omdat er formules niet mogen overschreven worden).

hieronder ook een macro, dewelke in de laatste kolom gebruikt wordt om de pauzetijden te berekenen en af te trekken van de ingevoerde uren.

Function Pause(Van, Tot, PauzeTabel As Range)
Dim W1 As Boolean, W2 As Boolean
For R = 1 To PauzeTabel.Rows.Count
W1 = Van < PauzeTabel(R, 1)
W2 = (Van < PauzeTabel(R, 2)) And Not W1
Pause = Pause - (PauzeTabel(R, 2) - PauzeTabel(R, 1)) * W1 - W2 * (PauzeTabel(R, 2) - Van)
Next R
For R = 1 To PauzeTabel.Rows.Count
W1 = Tot < PauzeTabel(R, 1)
W2 = (Tot < PauzeTabel(R, 2)) And Not W1
Pause = Pause + (PauzeTabel(R, 2) - PauzeTabel(R, 1)) * W1 + W2 * (PauzeTabel(R, 2) - Tot)
Next R
End Function

deze macro staat in module 1

zou het hieraan kunnen liggen mss?

de formule die ik gebruik in de laatste kolom is de volgende:

=ALS(((J16822-I16822)*24)-(Pause(I16822;J16822;PauseTabel)*24)>0;((J16822-I16822)*24)-(Pause(I16822;J16822;PauseTabel)*24);"")

kan dit jullie helpen? desnoods de formule rechtstreeks in de macro integreren???

bedankt!
spiesse

 

[MauriceSmit]

Aantal verbeterpunten
Wat je kunt doen is de sheets protecten. Je moet via celeigenschappen dan de cellen die wel mogen worden aangepast op 'unlocked' zetten en de anderen op 'locked'.
Dit gaat als volgt: range selecteren, rechtermuis, format cells, tabblad 'protection'. Het selectievak (de) selecteren.
Als je dan het sheet protect (via riboon review - protect sheet) zal excel automatisch de 'protected' cells skippen als je erdoorheen tabt.
Scheelt weer wat regels code / overhead. De gehele nieuwe code wordt dan:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next

dim LastCell as range
set LastCell = activesheet.cells(activesheet.usedrange.rows.count, KOLOMNUMMER)
If NOT Intersect(Target, LastCell) Is Nothing then 
Application.EnableEvents = False
Application.Screenupdating = False
If Int(Target.Value / 100) < 0.1 Then
Target = "00:" & Target.Value
Else
Target = Int(Target.Value / 100) & ":" & Right(Target.Value, 2)
End If
Activesheet.calculate
Application.EnableEvents = True
Application.screenupdating = true
End Sub

Ik ben overigens zelf geen voorstanden van de 'on error resume next' optie maar dat terzijde.

Wat voor mij echter wel lastig is; is om nu een inschatting te maken van welke formules/macros geïntegreerd / versoepeld kunnen worden zonder voorbeeld.
Wellicht een idee om een subset van je data in een nieuw tabblad te zetten; en in de kolommen erboven kort aan tegeven welk resultaat je wenst te zien.
Zodoende kan er evt wat geoptimaliseerd worden

 

[Spiesse]

Bekijk bijlage forum trage macro.xlsm

hierbij een iet of wat aangepast bestand, maar het principe is redelijk goed nagebootst

ik heb de huidige macro's behouden, dus je kan naar hartelust veranderen

er staat per tabblad een beetje info betreffende het originele bestand...

bij vragen moet je maar sturen!

 

[Warme bakkertje]

Moeten er in de regels die al ingevoerd zijn naderhand nog wijzigingen aangebracht worden? Zoniet zou je alle bovenliggende regels die al ingevuld zijn de celwaarde eventueel kunnen wijzigen naar de waarde die de functie gegenereerd heeft (het resultaat dus vastzetten zodat niet telkens alle regels opnieuw berekend worden).