Formules ophalen als cel gevuld is

[rienjanssen]

wie weet raad

Nu ik mijn rekenprogramma klaar heb krijg ik een probleem met het geheugen en de snelheid, als ik het opsla dan kom ik aan 15 mb opslag en wordt het een trage hap.

In kolom C staan tot maximaal 10.000 gegevens, de kolommen H tot AR bevatten formules

Waar ik naar opzoek ben dat is een formule in VBA waar in het mogelijk is om alle gevulde cellen (waarden van 0 tot 150) in kolom C ook de formule mee te geven in H tot AR Die formules worden over genomen uit rij 2
is er in geen waarde in bijv C100 dan ook geen Formule in cel H 100 tot en met AR 100

het liefst zou ik met een knop op het werkblad de VBA formule willen starten (macro toewijzen dat lukt me wel )

Wie kan me helpen
groet Rien

 

[leprechaun]

Met de voldende code zou het moeten lukken:

Sub Formules_vullen()

Dim i
Dim gevuld

For i = 2 To 10000
gevuld = Cells(i, 3).Value
If gevuld = "" Then GoTo volgende_rij

Range(Cells(2, 4), Cells(2, 34)).Select
Selection.Copy

Cells(i, 4).Select
ActiveSheet.Paste
Application.CutCopyMode = False

volgende_rij:
Next

Cells(1, 1).Select
End Sub

 

[rienjanssen]

Tot zover werkt het zoals het bedoeld is.
PERFECT !!!!:thumb: :thumb: :thumb:
Omdat er andere werkbladen ook gegevens putten uit het aangepaste werkblad wordt na iedere rij alles op nieuw berekend. in de andere werkbladen.
Dat is dus een uren lange wacht tijd en dat is lastig
Is het mogelijk om de berekening pas te starten als alle gegevens en formules gekopieerd zijn

Ik weet dat met de F9 toets handmatig berekenen mogelijk is maar dan zou dat alleen voor dit werkblad moeten gelden
Dus tot zover bedankt voor de hulp en mogelijk weet iemand hoe verder
groet Rien

 

[leprechaun]

Probeer eens of dit beter werkt:

Sub Formules_vullen()

Dim i
Dim gevuld

Application.Calculation = xlManual

For i = 2 To 10000
gevuld = Cells(i, 3).Value
If gevuld = "" Then GoTo volgende_rij

Range(Cells(2, 4), Cells(2, 34)).Select
Selection.Copy

Cells(i, 4).Select
ActiveSheet.Paste
Application.CutCopyMode = False

volgende_rij:
Next

Cells(1, 1).Select

Calculate
Application.Calculation = xlAutomatic
End Sub

 

[rienjanssen]

formules ophalen als cel gevuld is

Het gaat steeds beter, inderdaad het werkblad loopt meteen vol en gaat daarna pas rekenen. echter!!!

:thumb: :thumb: :thumb: :thumb: :thumb:

wat er dus gebeurd; vanuit een aparte data base haal ik cijfers op en die selectie kopieer ik in het werkblad INPUT, (Dit is een andere werkmap met verschillende werkbladen)



daarna worden die op gehaald en in het werkblad "rekenoverzicht" geplaatst.
Daarvoor staat in cel c2 staat onderstaande formule
=ALS(input!d2>1;input!d2;" ")

Als er geen data meer is in input dan staat er in het blad rekenoverzicht in die cel niets
Jouw oplossing gaat dan vrolijk toch door en zet 10.000 formules weg (tot het eind van het bereik) en wel RAAAAZEND snel, dat wel
Zou het een oplossing zijn als de vba formule kijkt naar waarde groter dan 1 in cel C .. en dan pas kopieert.

houd er rekening mee dat van kolom C tot en met kolom L komen gegevens van uit werkblad input, vanaf kolom M tot AS zijn het formules .En die moeten dan alleen verschijnen als C iets te melden heeft

Alvast bedankt voor de hulp
Groet Rien

 

[leprechaun]

Hoi Rien

Dat er in de cel niets staat op het moment dat de uitkomst van je functie ONWAAR is, is natuurlijk niet helemaal correct, er komt dan nl. een spatie te staan =ALS(input!d2>1;input!d2;" ").

Je kunt in dit geval twee dingen doen:

Verander de formules in kolom C naar =ALS(input!d2>1;input!d2;"").
(de spatie weghalen, dus)

Je kunt ook de VB-code aanpassen, dit wordt dan:
Sub Formules_vullen()

Dim i
Dim gevuld

For i = 2 To 10000
gevuld = Cells(i, 3).Value
If gevuld = " " Then GoTo volgende_rij

Range(Cells(2, 4), Cells(2, 34)).Select
Selection.Copy

Cells(i, 4).Select
ActiveSheet.Paste
Application.CutCopyMode = False

volgende_rij:
Next

Cells(1, 1).Select
End Sub
Dit zou je probleem op moeten lossen.

 

[Wigi]

De code van Leprechaun in de vorige post kan efficiënter:

Sub Formules_vullen()
    Dim i As Long
    For i = 2 To 10000
        If Cells(i, 3).Value <> " " Then Range(Cells(2, 4), Cells(2, 34)).Copy Cells(i, 4)
    Next
    Range("A1").Select
End Sub

Ik heb het niet getest bij gebrek aan voorbeeldbestand.

Lukt het?

Wigi