Help!

PC-Problemen?
De vrijwilligers van Oplossing.be zoeken gratis met u mee!

Hulp bij posten

Recente topics

Auteur Topic: vba for..next..-loop wegschrijfvraagje  (gelezen 9958 keer)

0 leden en 1 gast bekijken dit topic.

Offline MollyVH

  • Excel-Expert
  • Oplosser
  • *****
  • Berichten: 847
Re: vba for..next..-loop wegschrijfvraagje
« Reactie #90 Gepost op: 30 januari 2024, 11:20:46 »
Citaat
heb eindelijk de 'fout' in de code gevonden
de foutmelding kwam doordat de laatste rij in de gegevens leeg was bij een rows.count op de 1e kolom

O ja? Dan is het wel héél vreemd dat het bij mij wel werkte, want hoe had ik anders kunnen vaststellen dat mijn code 300 keer sneller was?
In je laatste voorbeeldbestand - het enig bruikbare voor de nieuwe code - was kolom A niet leeg, en diezelfde structuur had ik vanzelfsprekend meegenomen voor het toevoegen van een uitgebreid aantal rijen om zinvol te kunnen meten.

Groetjes,
Molly
Windows 11 Home NLD 64bit
11th Gen Intel(R) Core(TM) i7-11700 @ 2.50GHz 2496
Aspire TC-1660
Intel(R) UHD Graphics 750 1024MB
476 GB SSD KINGSTON OM8PCP3512F-AA
1863 GB HD Seagate ST2000DM008-2FR102
Office 2021 Professional Plus NLD 64bit

Offline BlackDevil

  • Ambassadeur
  • *****
  • Berichten: 1.031
  • Geslacht: Vrouw
  • veni vidi vici
Re: vba for..next..-loop wegschrijfvraagje
« Reactie #91 Gepost op: 30 januari 2024, 12:49:52 »
@Molly,

Op het werkblad "idx" heeft kolom A altijd 1 extra gevulde cel waarbij de andere kolommen op die rij 'leeg' zijn.
Doordat bij jou de variabele 'gegevens' gevuld werd op basis van de 'rows.count' op kolom A (werkblad "idx") waren de items "idx_type", "jaar" en "parochie" in de laatste rij van de variabele 'gegevens' dus leeg en dat was de reden van de foutmelding.

Wat betreft mijn extra 'inkorting' in het codeblok heb ik gewoon een logische redenering gemaakt.
In mijn initiële methode vulde ik een arraylist met de unieke jaren die ik vervolgens eerst wegschreef in kolom A van werkblad "jaarstats".
Om dan de telling te doen had ik een for-loop rechtstreeks op kolom A in werkblad 'jaarstats'.

Bij jouw 'versnelde' code werd het vullen van de arraylist en deze wegschrijven naar kolom A in werkblad "jaarstats" behouden om vervolgens die net geplaatste inhoud van kolom A opnieuw in een array te stoppen die dan gebruikt werd om via een for-loop te doorlopen.

Mijn redenering was bijgevolg "waarom eerst de arraylist wegschrijven om vervolgens met de ingevulde range opnieuw een array te maken als meteen gebruik gemaakt kan worden van de gevulde arraylist om de telling te doen en vervolgens aan het einde deze nog weggeschreven kan worden."

Ik heb dus gewoon een overbodige tussenstap weggelaten.
Voor de rest is jouw 'versnelde' methode een geweldige meerwaarde  _/-\o_ :thumbsup:, zeker eens ik duizenden rijen ga hebben (die minimum 2000 rijen uit de vorige versies (met nog 6 'idx'-werkbladen) was gerekend per werkblad, dus gezien deze 6 werkbladen nu gecombineerd worden in 1 werkblad kan het minimum op zeker +10000 rijen gesteld worden).

groetjes,
Bieke
1) HP ProDesk (Windows 10 Pro Edu / Intel(R) Core(TM) i5-7500 CPU@ 3.40Ghz 3.41Ghz)
2) Laptop ASUS (Windows 10 Home / Intel(R) Core(TM) i3-3110M CPU@ 2.40GHz 2.40GHz)
Beide (RAM : 8,00 GB / 64-bits besturingssysteem, x64-processor)
Extern (Seagate Backup+ Hub 6TB / Seagate BUP Slim 2TB / Seagate Expansion Desk 5TB / HP ENVY 6030e)
Bullguard Premium Protection / Office Pro Plus 2016 NL

Offline BlackDevil

  • Ambassadeur
  • *****
  • Berichten: 1.031
  • Geslacht: Vrouw
  • veni vidi vici
Re: vba for..next..-loop wegschrijfvraagje
« Reactie #92 Gepost op: 30 januari 2024, 15:30:54 »
Goede namiddag allemaal,

Betreft het volgende onderdeel in het project.

In voorgaande projecten had ik een berekenings-procedure ontwikkeld om enerzijds de leeftijden snel te kunnen berekenen en om anderzijds op basis van de gekende datum mbt geboorte, huwelijk en/of overlijden van een koppel de zoekperiode voor potentiële kinderen te kunnen vastleggen.

Niettegenstaande dat deze berekenings-procedure goed dienst deed was ze toch relatief beperkend (enkel (deels) bruikbaar bij minstens 2 gekende gegevens (datums en/of leeftijden)) en ‘ontbreekt’ er dus iets.

Voor mijn nieuw project zou ik dus deze berekenings-procedure aanzienlijk willen uitbreiden.
Zo wil ik, wat het koppel zelf betreft, niet enkel de leeftijd berekenen bij gekende datums, maar wil ik ook de zoekperiodes (mbt de registers) voor ontbrekende datums berekenen op basis van andere gekende datums en/of leeftijden.
Voor de berekeningen op zich heb ik al een goed beeld voor ogen (en de juiste code) maar bij uitbreidingen komen sowieso ook meer voorwaarden/criteria aan bod en daar kom ik met mijn beperkte kennis wat in de knoop te zitten met het vinden van de correcte structuur voor alle voorwaarden/criteria in zijn geheel.
Mbt het koppel zelf zijn er 5 mogelijke datums (2 mbt de man, 2 mbt de vrouw en dan de gezamenlijke huw-datum), daarnaast zijn er dan ook nog 2 leeftijdsberekeningen voor de man en 2 voor de vrouw.
De leeftijdsberekeningen en zoekperiodes voor ontbrekend huwelijk en/of overlijden zijn relatief simpel zolang de geboortedatum gekend is. Het wordt pas uitdagend als de geboortedatum (nog) niet gekend is.
Ik ben al twee dagen pogingen aan het ondernemen om een fysieke flow-chart te maken maar het blijft een moeilijk te ontwarren resultaat. (mogelijks zoek ik het alweer veel te ver ;D )

Daarom hoop ik dat iemand hier misschien een goeie tip heeft om op een makkelijkere wijze een logisch en overzichtelijke structuur uit te kunnen werken voor de diverse voorwaarden/criteria.
De flow-chart is blijkbaar niet de ideale way-to-go.

Verder wil ik dan ook de zoekperiodes voor potentiële kinderen op een iets andere wijze gaan berekenen. Maar dat is voor de volgende fase.

In bijlage een voorbeeldbestand met de lay-out van het werkblad waarop het allemaal zal gebeuren.
De cellen met groene achtergrond zijn uitsluitend voor input door de gebruiker.
De cellen met grijze achtergrond zijn uitsluitend voor input door VBA.

Groetjes,
Bieke
1) HP ProDesk (Windows 10 Pro Edu / Intel(R) Core(TM) i5-7500 CPU@ 3.40Ghz 3.41Ghz)
2) Laptop ASUS (Windows 10 Home / Intel(R) Core(TM) i3-3110M CPU@ 2.40GHz 2.40GHz)
Beide (RAM : 8,00 GB / 64-bits besturingssysteem, x64-processor)
Extern (Seagate Backup+ Hub 6TB / Seagate BUP Slim 2TB / Seagate Expansion Desk 5TB / HP ENVY 6030e)
Bullguard Premium Protection / Office Pro Plus 2016 NL

Offline BlackDevil

  • Ambassadeur
  • *****
  • Berichten: 1.031
  • Geslacht: Vrouw
  • veni vidi vici
Re: vba for..next..-loop wegschrijfvraagje
« Reactie #93 Gepost op: 01 februari 2024, 15:44:41 »
***update***

De laatste 2 dagen ben ik pogingen blijven ondernemen om het beste “startpunt” te vinden (dus nu al 4 dagen op rij zonder succes).
Het lukt me echter niet om een beknopte efficiënte en vooral overzichtelijke structuur te creëren.
Een geneste ‘if’-structuur levert mij, welke volgorde ik ook probeer, al snel meer dan 100 lijntjes code op en dat is dan nog maar enkel voor het berekenen van de zoekperiodes mbt ontbrekende datums van een koppel (ouders).

Om het toch een beetje ‘beknopt’ te houden ben ik nu eventjes afgestapt van het ‘geneste’ aspect van de if-structuur waarbij ik maar 1/3de van het aantal lijntjes (tov geneste structuur) meer nodig heb MAAR het is allesbehalve ‘overzichtelijk’ te noemen waardoor ik door de bomen het bos niet meer zie (of omgekeerd).

Daarom wou ik nu vragen of er iemand een tip/idee heeft hoe ik van onderstaande code (= enkel de code mbt de man) een overzichtelijke efficiënte code kan maken ZONDER dat het een ellenlange structuur wordt?

'MAN
    If gdatman <> "" Then Cells(21, 4) = "nvt": Cells(21, 6) = "nvt"
    If hdat <> "" Then Cells(22, 4) = "nvt": Cells(22, 6) = "nvt"
    If odatman <> "" Then Cells(23, 4) = "nvt": Cells(23, 6) = "nvt"
    'ZP geboorte man berekenen
    If gdatman = "" And hdat <> "" Then Cells(21, 4) = Format(DateAdd("yyyy", -76, hdat), "dd-mm-yyyy"): Cells(21, 6) = Format(DateAdd("yyyy", -18, hdat), "dd-mm-yyyy")
    If gdatman = "" And hlftdman <> "" Then Cells(21, 4) = Format(DateAdd("yyyy", -(hlftdman + 1), hdat), "dd-mm-yyyy"): Cells(21, 6) = Format(DateAdd("yyyy", -hlftdman, hdat), "dd-mm-yyyy")
    If gdatman = "" And hdat = "" And odatman <> "" Then Cells(21, 4) = Format(DateAdd("yyyy", -101, odatman), "dd-mm-yyyy"): Cells(21, 6) = Format(DateAdd("yyyy", -18, odatman), "dd-mm-yyyy")
    If gdatman = "" And hdat = "" And olftdman <> "" Then Cells(21, 4) = Format(DateAdd("yyyy", -(olftdman + 1), odatman), "dd-mm-yyyy"): Cells(21, 6) = Format(DateAdd("yyyy", -olftdman, odatman), "dd-mm-yyyy")
    'ZP huwelijk man berekenen
    If hdat = "" And gdatman <> "" Then Cells(22, 4) = Format(DateAdd("yyyy", 18, gdatman), "dd-mm-yyyy"): Cells(22, 6) = Format(DateAdd("yyyy", 75, gdatman), "dd-mm-yyyy")
    If hdat = "" And gdatman <> "" And odatman <> "" Then Cells(22, 4) = Format(DateAdd("yyyy", 18, gdatman), "dd-mm-yyyy"): Cells(22, 6) = Format(DateAdd("yyyy", 0, odatman), "dd-mm-yyyy")
    If hdat = "" And gdatman = "" And odatman <> "" Then Cells(22, 4) = Format(DateAdd("yyyy", -83, odatman), "dd-mm-yyyy"): Cells(22, 6) = Format(DateAdd("yyyy", 0, odatman), "dd-mm-yyyy")
    If hdat = "" And gdatman = "" And olftdman <> "" Then Cells(22, 4) = Format(DateAdd("yyyy", -(olftdman + 18), odatman), "dd-mm-yyyy"): Cells(22, 6) = Format(DateAdd("yyyy", 0, odatman), "dd-mm-yyyy")
    'ZP overlijden man berekenen
    If odatman = "" And gdatman <> "" Then Cells(23, 4) = Format(DateAdd("yyyy", 18, gdatman), "dd-mm-yyyy"): Cells(23, 6) = Format(DateAdd("yyyy", 100, gdatman), "dd-mm-yyyy")
    If odatman = "" And hdat <> "" Then Cells(23, 4) = Format(DateAdd("yyyy", 0, hdat), "dd-mm-yyyy"): Cells(23, 6) = Format(DateAdd("yyyy", 82, hdat), "dd-mm-yyyy")
    If odatman = "" And hlftdman <> "" Then Cells(23, 4) = Format(DateAdd("yyyy", 0, hdat), "dd-mm-yyyy"): Cells(23, 6) = Format(DateAdd("yyyy", (100 - hlftdman), hdat), "dd-mm-yyyy")
    'leeftijd man bij huwelijk en overlijden berekenen
    If gdatman <> "" And hdat <> "" Then Cells(9, 4) = Application.WorksheetFunction.RoundDown(DateDiff("m", gdatman, hdat) / 12, 0) & " jaar, " & DateDiff("m", gdatman, hdat) - _
            (Application.WorksheetFunction.RoundDown(DateDiff("m", gdatman, hdat) / 12, 0) * 12) & " maand "
    If gdatman <> "" And odatman <> "" Then Cells(11, 4) = Application.WorksheetFunction.RoundDown(DateDiff("m", gdatman, odatman) / 12, 0) & " jaar, " & DateDiff("m", gdatman, odatman) - _
            (Application.WorksheetFunction.RoundDown(DateDiff("m", gdatman, odatman) / 12, 0) * 12) & " maand "

Alvast dank voor het meedenken.

Groetjes,
Bieke
1) HP ProDesk (Windows 10 Pro Edu / Intel(R) Core(TM) i5-7500 CPU@ 3.40Ghz 3.41Ghz)
2) Laptop ASUS (Windows 10 Home / Intel(R) Core(TM) i3-3110M CPU@ 2.40GHz 2.40GHz)
Beide (RAM : 8,00 GB / 64-bits besturingssysteem, x64-processor)
Extern (Seagate Backup+ Hub 6TB / Seagate BUP Slim 2TB / Seagate Expansion Desk 5TB / HP ENVY 6030e)
Bullguard Premium Protection / Office Pro Plus 2016 NL

Offline MollyVH

  • Excel-Expert
  • Oplosser
  • *****
  • Berichten: 847
Re: vba for..next..-loop wegschrijfvraagje
« Reactie #94 Gepost op: 02 februari 2024, 10:30:28 »
Hey Bieke,

Ik krijg er ('déjà vu'-gewijs) het gevoel bij dat je te erg de focus legt op de lengte van code. Voor mij is dat altijd de laatste van mijn zorgen: eerst zorgen dat ze werkt, daarna aandacht voor een zo kort mogelijke verwerkingstijd, in de mate van het mogelijke ook nog zorgen dat ze ook door anderen te begrijpen is, en optioneel ze niet langer schrijven dan nodig...
Met wat je nu wil realiseren is er vermoedelijk op dat laatste punt nog wat winst te halen, maar 'kort' zal je het niet echt krijgen. Je hebt te maken met 5 variabelen die elk, los van de andere, 'iets' of 'niets' kunnen zijn, dat geeft 2^5 (=32) mogelijke combinaties waarbij telkens (of ongeveer telkens?) iets anders moet gebeuren.

Ik ga me er echt niet aan wagen om je code om te gooien (het is quasi zeker dat het dan wel ergens fout gaan, want niemand weet beter dan jij wat, waar, wanneer, hoe en waarom), maar mijn persoonlijke voorkeur zou uitgaan naar meer geneste if-constructies i.p.v. een serie if-constructies met 2 of meer voorwaarden. Dat zal de code niet korter maken maar m.i. wel overzichtelijker. Dat flowchart-idee uit je voorgaande post zou hier zeker van pas zijn gekomen.

Daarnaast, en dat durf ik wat radicaler uitdrukken, zou ik hier gebruik maken van een udf voor de leeftijdsberekeningen!
En aangezien je geposte code enkel voor de man is, en die voor de vrouw er geweldig zal op lijken, kan dat voor de rest van de code misschien ook een optie zijn.

Groetjes,
Molly
Windows 11 Home NLD 64bit
11th Gen Intel(R) Core(TM) i7-11700 @ 2.50GHz 2496
Aspire TC-1660
Intel(R) UHD Graphics 750 1024MB
476 GB SSD KINGSTON OM8PCP3512F-AA
1863 GB HD Seagate ST2000DM008-2FR102
Office 2021 Professional Plus NLD 64bit

Offline BlackDevil

  • Ambassadeur
  • *****
  • Berichten: 1.031
  • Geslacht: Vrouw
  • veni vidi vici
Re: vba for..next..-loop wegschrijfvraagje
« Reactie #95 Gepost op: 02 februari 2024, 14:06:42 »
@Molly,

wou net nog eens een update komen plaatsen als ik zag dat je een bericht had geplaatst.

Even ter info :
Het streven naar "korte" code is in eerste instantie in mijn geval zelden mbt de verwerkingstijd hoor, het is in mijn geval vooral mbt de leesbaarheid.
ik werk op een 24" scherm en dan heb ik in de VB Editor een beeldhoogte die overeenkomt met zo'n 50 lijntjes als mijn deelvensters "direct" en "lokale var" buiten beeld zijn.  Ik heb dus graag een volledig overzicht van samenhorende code-blokjes zodat ik het makkelijker in zijn "geheel" kan zien om verbeteringen aan te brengen en/of mogelijke overbodige of verkeerde code op te merken.
Soms kan je uiteraard "lange" code niet vermijden en in dat geval probeer ik dan bepaalde onderdelen in een 2e sub te plaatsen om het geheel alsnog in te korten.
Uiteindelijk, in tweede instantie, buig ik me dan ook over een snellere verwerkingstijd.

en dan nu mijn update die ik kwam plaatsen  :) :
**update**
Bij gebrek aan een betere methode dan de “geneste” if-structuur en om de lengte ervan toch een beetje te beperken heb ik de kleine verschillen tussen man en vrouw, mbt de berekeningen, geëlimineerd zodat de berekeningen identiek werden tussen man en vrouw en heb ik ze in een ‘for…’-loop gestoken zodat de lengte van het geheel gehalveerd kon worden.

Niettegenstaande het wss niet de ‘ideale’ oplossing is zal het (voorlopig) alzo dienst moeten doen.
Ik heb nog té veel andere procedures te schrijven om hierop te blijven vast zitten…. Ik heb er nu al 5 dagen tijd mee verloren.

Voor diegenen die het project mee volgen en/of hier en daar helpen is dit de (voorlopige) code om de zoekperiodes van ontbrekende datums mbt man en vrouw te berekenen alsook de globale zoekperiodes voor de potentiële kinderen vast te leggen (code achter het werkblad) :

Sub gezinsberekeningPrt1()
  Dim zpman As Variant, zpvrw As Variant, zp As Variant, g, h, o, hlftd, olftd, fert1, fert2
  For kol = 4 To 7 Step 3
    zp = Array("nvt", "nvt", "nvt", "nvt", "nvt", "nvt")
    ReDim Preserve zp(1 To 6)
    If Cells(5, kol) <> "" Then g = DateValue(Cells(5, kol))
    If Cells(6, 4) <> "" Then h = DateValue(Cells(6, 4))
    If Cells(7, kol) <> "" Then o = DateValue(Cells(7, kol))
    hlftd = Cells(10, kol)
    olftd = Cells(12, kol)
    If g = "" Then
      If h <> "" Then
        If hltfd <> "" Then
          zp(1) = DateAdd("yyyy", -(hlftd + 1), h): zp(2) = DateAdd("yyyy", -hlftd, h)
        Else
          zp(1) = DateAdd("yyyy", -76, h): zp(2) = DateAdd("yyyy", -75, h)
        End If
      Else
        If o <> "" Then
          If olftd <> "" Then
            zp(1) = DateAdd("yyyy", -(olftd + 1), o): zp(2) = DateAdd("yyyy", -olftd, o)
          Else
            zp(1) = DateAdd("yyyy", -101, o): zp(2) = DateAdd("yyyy", -100, o)
          End If
        End If
      End If
    End If
    If h = "" Then
      If g <> "" Then
        zp(3) = DateAdd("yyyy", 18, g): zp(4) = DateAdd("yyyy", 75, g)
      Else
        If o <> "" Then
          zp(4) = o
          If olftd <> "" Then zp(3) = DateAdd("yyyy", -(olftd - 17), o) Else zp(3) = DateAdd("yyyy", -83, o)
        End If
      End If
    End If
    If o = "" Then
      If g <> "" Then
        zp(5) = DateAdd("yyyy", 18, g): zp(6) = DateAdd("yyyy", 100, g)
      Else
        If h <> "" Then
          zp(5) = h
          If hlftd <> "" Then zp(6) = DateAdd("yyyy", 100 - hlftd, h) Else zp(6) = DateAdd("yyyy", 82, h)
        End If
      End If
    End If
    If kol = 4 Then zpman = zp
    If kol = 7 Then zpvrw = zp
    If g <> "" And h <> "" Then Cells(9, kol) = Application.WorksheetFunction.RoundDown(DateDiff("m", g, h) / 12, 0) & " jaar, " & DateDiff("m", g, h) - _
            (Application.WorksheetFunction.RoundDown(DateDiff("m", g, h) / 12, 0) * 12) & " maand "
    If g <> "" And o <> "" Then Cells(11, kol) = Application.WorksheetFunction.RoundDown(DateDiff("m", g, o) / 12, 0) & " jaar, " & DateDiff("m", g, o) - _
            (Application.WorksheetFunction.RoundDown(DateDiff("m", g, o) / 12, 0) * 12) & " maand "
  Next kol
  ReDim Preserve zpman(1 To 6)
  ReDim Preserve zpvrw(1 To 6)
  i = 1
  For rij = 21 To 23
    Cells(rij, 4) = zpman(i): Cells(rij, 6) = zpman(i + 1)
    Cells(rij, 7) = zpvrw(i): Cells(rij, 9) = zpvrw(i + 1)
    i = i + 2
  Next rij
  'globale gemiddelde fertiliteitsperiode vrouw (in principe kan het jonger dan 16 en ouder dan 48 maar is eerder uitzonderlijk en de grens moet ergens getrokken worden)
  If Cells(5, 7) <> "" Then fert1 = DateAdd("yyyy", 16, DateValue(Cells(5, 7))): fert2 = DateAdd("yyyy", 48, DateValue(Cells(5, 7)))
  'zoekperiode potentiële kinderen pré-huwelijk
  Cells(6, 26) = fert1
  If Cells(6, 4) <> "" Then If DateValue(Cells(6, 4)) < fert2 Then Cells(6, 29) = DateAdd("d", -1, DateValue(Cells(6, 4))) Else Cells(6, 29) = fert2
  If Cells(6, 4) = "" Then Cells(6, 29) = fert2
  'zoekperiode potentiële kinderen binnen het huwelijk
  If Cells(6, 4) <> "" Then If DateValue(Cells(6, 29)) <> fert2 Then Cells(12, 26) = DateValue(Cells(6, 4)) Else Cells(12, 26) = "nvt": Cells(12, 29) = "nvt"
  If Cells(7, 7) = "" And Cells(12, 29) <> "nvt" Then Cells(12, 29) = fert2
  If Cells(7, 7) <> "" And Cells(12, 29) <> "nvt" Then If DateValue(Cells(7, 7)) > fert2 Then Cells(12, 29) = DateValue(Cells(7, 7))
  If Cells(7, 4) <> "" And Cells(12, 29) <> "nvt" Then If DateAdd("m", 9, DateValue(Cells(7, 4))) < DateValue(Cells(12, 29)) Then Cells(12, 29) = DateValue(Cells(7, 4))
End Sub

De enkele testjes die ik ermee heb uitgevoerd waren allen succesvol.
De échte uitgebreide test zal ik echter pas kunnen uitvoeren eens ik het bestand definitief in gebruik neem.

Groetjes,
Bieke
1) HP ProDesk (Windows 10 Pro Edu / Intel(R) Core(TM) i5-7500 CPU@ 3.40Ghz 3.41Ghz)
2) Laptop ASUS (Windows 10 Home / Intel(R) Core(TM) i3-3110M CPU@ 2.40GHz 2.40GHz)
Beide (RAM : 8,00 GB / 64-bits besturingssysteem, x64-processor)
Extern (Seagate Backup+ Hub 6TB / Seagate BUP Slim 2TB / Seagate Expansion Desk 5TB / HP ENVY 6030e)
Bullguard Premium Protection / Office Pro Plus 2016 NL

 


www.combell.com