Help!

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

Hulp bij posten

Recente topics

Auteur Topic: dubbele lus om doellocatie x-aantal keer te verplaatsen per x-aantal records  (gelezen 780 keer)

0 leden en 1 gast bekijken dit topic.

Offline BlackDevil

  • Ambassadeur
  • *****
  • Berichten: 1.029
  • Geslacht: Vrouw
  • veni vidi vici
Goede namiddag allen,

Ik zit eventjes wat in de knoop.

Ik heb dus onderstaand code-blokje om bepaalde gegevens uit het bronwerkblad weg te schrijven naar het doelwerkblad. Dat op zich is geen probleem en werkt naar behoren.

With Sheets("htafel")
    rijen = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = 3 To rijen
      test = Left(.Cells(i, 8), 4)
      If .Cells(i, 9) = gem And test >= startjr And test <= stopjr Then
        naam1 = .Cells(i, 1) & " " & .Cells(i, 2)
        naam2 = .Cells(i, 3) & " " & .Cells(i, 4)
        datum = .Cells(i, 5)
        akte = .Cells(i, 6)
       
        With Sheets("tflprnt")
          tfl = .Cells(Rows.Count, p).End(xlUp).Row + 1
          .Cells(tfl, 1) = naam1
          .Cells(tfl, 2) = "&"
          .Cells(tfl, 3) = naam2
          .Cells(tfl, 4) = datum
          .Cells(tfl, 5) = akte
        End With
      End If
    Next i
  End With

Nu zou ik echter willen verkrijgen dat op het doelwerkblad, na rij 46 (dus na 45 records), het wegschrijven verdergaat op rij 2 maar dan 5 kolommen naar rechts en dit telkens opnieuw tot alle betreffende records uit het bronwerkblad zijn weggeschreven.

Ik weet dat ik dit in principe kan verkrijgen met een dubbele loop inzake enerzijds de rijen en anderzijds de kolommen maar ik raak er eventjes niet meer uit waar ik deze dan juist moet plaatsen en in welke volgorde.

Wie wil mij op weg helpen?

PS : het codeblokje maakt deel uit van een macro achter de opdrachtknop van een UserForm.


Alvast mijn oprechte dank.
groetjes,
BlackDevil
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: dubbele lus om doellocatie x-aantal keer te verplaatsen per x-aantal records
« Reactie #1 Gepost op: 30 november 2021, 15:21:02 »
Hallo BlackDevil,

Of dit 'gewoon makkelijk' of eerder héél makkelijk zal zijn hangt af van de vraag of het doelwerkblad bij het uitvoeren van de macro al gegevens bevat, dus laat maar weten. Nóg beter zou uiteraard een voorbeeldbestandje zijn.
Ik kan je trouwens wel al meegeven dat ik de noodzaak van een dubbele loop (voorlopig?) niet zie...

Mvg,
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 SoftAid

  • Administrator
  • Ambassadeur
  • *****
  • Berichten: 20.129
  • Geslacht: Man
  • Nobody is perfect, not even me...
Re: dubbele lus om doellocatie x-aantal keer te verplaatsen per x-aantal records
« Reactie #2 Gepost op: 30 november 2021, 15:46:36 »
Zoals MollyVH aangeeft is een voorbeeldbestandje "completer" en kan men de code testen.
Nu ontbreken er te veel variabelen.

Zoals ik het OldSchool zou doen, uit het duimpje.....
Rood zijn de aanpassingen:

With Sheets("htafel")
    rijen = .Cells(Rows.Count, 1).End(xlUp).Row
   a = 1
   b = 1
 For i = 3 To rijen
   
      test = Left(.Cells(i, 8), 4)   'De smilie is een 8 ;-)
      If .Cells(i, 9) = gem And test >= startjr And test <= stopjr Then
        naam1 = .Cells(i, 1) & " " & .Cells(i, 2)
        naam2 = .Cells(i, 3) & " " & .Cells(i, 4)
        datum = .Cells(i, 5)
        akte = .Cells(i, 6)
       
        With Sheets("tflprnt")
          tfl = .Cells(Rows.Count, p).End(xlUp).Row + 1
          If i = 46 * b Then
           a = a + 5
      End If

          .Cells(tfl, a) = naam1
          .Cells(tfl, a + 1) = "&"
          .Cells(tfl, a + 2) = naam2
          .Cells(tfl, a + 3) = datum
          .Cells(tfl, a + 4) = akte
         
        End With
      End If
      b = b + 1
    Next i
  End With

:) SoftAid :)             
Maximum grootte bijlagen vergroot naar 4 MB
Dubbelposten, het posten op verschillende forums van dezelfde vraag, dient op
voorhand gemeld te worden, met een link naar het topic op de andere site.
Overtreding van deze regel kan bestraft worden met verbanning !

Offline BlackDevil

  • Ambassadeur
  • *****
  • Berichten: 1.029
  • Geslacht: Vrouw
  • veni vidi vici
Re: dubbele lus om doellocatie x-aantal keer te verplaatsen per x-aantal records
« Reactie #3 Gepost op: 30 november 2021, 15:49:45 »
Hey MollyVH,

Alvast dank voor je reactie.
Ik was volop bezig met het voorbeeldbestand klaar te maken om hier aan te hangen maar het was hier vandaag nogal hectisch door
het afstandsonderwijs van de dochter dat vandaag terug gestart is waarbij mij vaak dingen gevraagd werden, enz.. Hierdoor heb ik wat vertraging opgelopen met het voorbeeldbestand  :D.

Het doelwerkblad heeft een bepaalde lay-out om uiteindelijk te kunnen printen als PDF (die code komt later nog aan bod).
Om ervoor te zorgen dat de gegevens telkens worden weggeschreven 'per pagina' is het dus noodzakelijk dat na 45 records
het wegschrijven 5 kolommen opschuift. De wegschrijf range per rij zijn telkens 5 kolommen.
Aan het begin van de macro zullen er dus enkel kolomtitels aanwezig zijn, maar (nog) geen gegevens uit het bronwerkblad.

Het betreft UserForm3 dat aangeroepen wordt via de opdrachtknop 'selectie' op werkblad "htafel" waarbij een keuze gemaakt moet worden en op basis van die keuze moeten dan via de opdrachtknop op het UserForm3 via tal van voorwaarden en parameters de betreffende records weggeschreven worden naar het betreffende doelwerkblad.

In bijlage dus mijn voorbeeldbestandje.
PS : vooral niet letten op de huidige gegevens die erin staan, dit was louter om de nodige testjes te kunnen uitvoeren.

groetjes,
BlackDevil

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.029
  • Geslacht: Vrouw
  • veni vidi vici
Re: dubbele lus om doellocatie x-aantal keer te verplaatsen per x-aantal records
« Reactie #4 Gepost op: 30 november 2021, 16:02:44 »
@SoftAid,

Uiteraard, zo simpel....  ;), ik ging het weer (zoals gewoonlijk) veel te ver zoeken  ;D....

Ach ja, zal de slijtage zijn zeker  :D :D :D


groetjes,
BlackDevil
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: dubbele lus om doellocatie x-aantal keer te verplaatsen per x-aantal records
« Reactie #5 Gepost op: 30 november 2021, 16:13:39 »
Hallo,

Ik vrees dat er een minuscuul denkfoutje zit in de methode van SoftAid (zowel i als b verhogen binnen dezelfde lus en dus blijf je verder schrijven in de eerste 5 kolommen).

Ondertussen had ik er ook eentje klaar:
rij = 1: kolom = 1
With Sheets("htafel")
    rijen = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = 3 To rijen
      test = Left(.Cells(i, 8), 4)
      If .Cells(i, 9) = gem And test >= startjr And test <= stopjr Then
        naam1 = .Cells(i, 1) & " " & .Cells(i, 2)
        naam2 = .Cells(i, 3) & " " & .Cells(i, 4)
        datum = .Cells(i, 5)
        akte = .Cells(i, 6)
        If rij = 46 Then
            rij = 2
            kolom = kolom + 5
        Else
            rij = rij + 1
        End If
        Sheets("tflprnt").Cells(rij, kolom).Resize(, 5) = Array(naam1, "&", naam2, datum, akte)
      End If
    Next i
End With

Mvg,
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.029
  • Geslacht: Vrouw
  • veni vidi vici
Re: dubbele lus om doellocatie x-aantal keer te verplaatsen per x-aantal records
« Reactie #6 Gepost op: 30 november 2021, 16:25:06 »
@MollyVH,

Dank voor je aangereikte code. Dat was de methode die ik zocht (had enkele jaren geleden ook al eens iets dergelijks gebruikt maar was de opbouw-wijze helemaal kwijt)  :thumbsup:.

Ik vrees dat er een minuscuul denkfoutje zit in de methode van SoftAid (zowel i als b verhogen binnen dezelfde lus en dus blijf je verder schrijven in de eerste 5 kolommen).
Wel, ik maakte mezelf ook even die bedenking maar gezien ik nog echt een 'leek' ben tov de meesten hier dacht ik dat ik het waarschijnlijk wel verkeerd voorhad. :D


Ik ga nu aan de slag met jouw codeblokje. Nogmaals mijn oprechte dank  _/-\o_.


groetjes,
BlackDevil
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.029
  • Geslacht: Vrouw
  • veni vidi vici
Re: dubbele lus om doellocatie x-aantal keer te verplaatsen per x-aantal records
« Reactie #7 Gepost op: 30 november 2021, 17:42:25 »
Zoals MollyVH aangeeft is een voorbeeldbestandje "completer" en kan men de code testen.
Nu ontbreken er te veel variabelen.

Zoals ik het OldSchool zou doen, uit het duimpje.....
Rood zijn de aanpassingen:

With Sheets("htafel")
    rijen = .Cells(Rows.Count, 1).End(xlUp).Row
   a = 1
   b = 1
 For i = 3 To rijen
   
      test = Left(.Cells(i, 8), 4)   'De smilie is een 8 ;-)
      If .Cells(i, 9) = gem And test >= startjr And test <= stopjr Then
        naam1 = .Cells(i, 1) & " " & .Cells(i, 2)
        naam2 = .Cells(i, 3) & " " & .Cells(i, 4)
        datum = .Cells(i, 5)
        akte = .Cells(i, 6)
       
        With Sheets("tflprnt")
          tfl = .Cells(Rows.Count, p).End(xlUp).Row + 1
          If i = 46 * b Then
           a = a + 5
      End If

          .Cells(tfl, a) = naam1
          .Cells(tfl, a + 1) = "&"
          .Cells(tfl, a + 2) = naam2
          .Cells(tfl, a + 3) = datum
          .Cells(tfl, a + 4) = akte
         
        End With
      End If
      b = b + 1
    Next i
  End With

:) SoftAid :)             

Nog een kleine bedenking bij deze methode....
i staat in het betreffende code-blokje voor het rijnummer uit het bronwerkblad.
dus de If i = 46 * b Then kan nooit kloppen aangezien enerzijds niet elk record uit de bron moet overgenomen worden
en anderzijds het in het doelwerkblad is dat er na rij 46 moet verplaatst worden naar rechts (en terug bovenaan).
Dus moet het dan niet eerder If tfl = ..... then zijn?

Allez ja, is maar mijn bescheiden (amateuristische) mening hé  :D excuses indien ik ook verkeerd zit nu... :-[

groetjes,
BlackDevil
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 SoftAid

  • Administrator
  • Ambassadeur
  • *****
  • Berichten: 20.129
  • Geslacht: Man
  • Nobody is perfect, not even me...
Re: dubbele lus om doellocatie x-aantal keer te verplaatsen per x-aantal records
« Reactie #8 Gepost op: 30 november 2021, 18:28:01 »
Hallo BlackDevil,

toont nogmaals aan hoe belangrijk het is om een voorbeeldbestand toe te voegen, in plaats van (een deel van) de code.

succes,

:) SoftAid :)             
Maximum grootte bijlagen vergroot naar 4 MB
Dubbelposten, het posten op verschillende forums van dezelfde vraag, dient op
voorhand gemeld te worden, met een link naar het topic op de andere site.
Overtreding van deze regel kan bestraft worden met verbanning !

Offline BlackDevil

  • Ambassadeur
  • *****
  • Berichten: 1.029
  • Geslacht: Vrouw
  • veni vidi vici
Re: dubbele lus om doellocatie x-aantal keer te verplaatsen per x-aantal records
« Reactie #9 Gepost op: 30 november 2021, 19:02:13 »
@SoftAid,

Ik begrijp zeker de zin van een voorbeeldbestand  :thumbsup:, en ik probeer dit ook zo vaak mogelijk, in de mate van het mogelijke, bij te voegen. ;)

maar wat ik in mijn eerste bericht had meegegeven was wel degelijk een volledig code-blok, geen gedeeltelijk.  ;D
Ik ging er dan ook van uit dat het code-blok op zich voldoende duidelijkheid gaf over welk deel betrekking had op het bronwerkblad (=inleescode)  en welk deel betrekking had op het doelwerkblad (=wegschrijfcode)  :).
Mijn excuses voor de foutieve veronderstelling. :-[



groetjes,
BlackDevil



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 SoftAid

  • Administrator
  • Ambassadeur
  • *****
  • Berichten: 20.129
  • Geslacht: Man
  • Nobody is perfect, not even me...
Re: dubbele lus om doellocatie x-aantal keer te verplaatsen per x-aantal records
« Reactie #10 Gepost op: 30 november 2021, 19:37:15 »
maar wat ik in mijn eerste bericht had meegegeven was wel degelijk een volledig code-blok, geen gedeeltelijk.  ;D
Ik ging er dan ook van uit dat het code-blok op zich voldoende duidelijkheid gaf over welk deel betrekking had op het bronwerkblad (=inleescode)  en welk deel betrekking had op het doelwerkblad (=wegschrijfcode)  :).
Dat begrijp ik, maar dan moeten helpers dat code blok in een nieuw aan te maken bestand gaan stoppen, bedenken wat de variabelen zijn, en zelf een werkblad aanmaken. Gelukkig heb je toppers als Veerj, Albert, MollyVH die dat zullen opvangen, maar ook zij vragen naar een voorbeeldbestand.

Losse (delen van) code enkel plaatsen is dan zeker geen goede bron.

Groetjes,

:) SoftAid :)             

Maximum grootte bijlagen vergroot naar 4 MB
Dubbelposten, het posten op verschillende forums van dezelfde vraag, dient op
voorhand gemeld te worden, met een link naar het topic op de andere site.
Overtreding van deze regel kan bestraft worden met verbanning !

 


www.combell.com