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

BlackDevil · « **Gepost op:** 10 januari 2024, 14:44:50 »

Goedenamiddag allemaal,

Vermoedelijk is er vermoeidheid mee gemoeid maar ik zit al enkele uren te zoeken op iets wat volgens
mij behoorlijk simpel zal zijn maar ik raak er gewoonweg niet uit.

Ik heb in mijn Sub volgend codeblokje :

Code: [Selecteer]

With Sheets("famnm-lijst")
  For f = 0 To UBound(arFamnm)
    On Error Resume Next
    fkol = Left(arFamnm(f), 1)
    If Application.CountIf(.Columns(fkol), arFamnm(f)) = 0 Then
      rij = .Cells(Rows.Count, fkol).End(xlUp).Row
      .Cells(rij + 1, fkol) = arFamnm(f)
    End If
  Next f
  .Columns("A:Z").EntireColumn.AutoFit
End With

De code doet exact wat het moet doen mits één klein puntje...
Voor elke kolom wordt de allereerste waarde weggeschreven op rij 2 maar gezien ik geen kolomtitels heb
zou ik dit graag op de 1e rij laten starten...
Maar de enige poging waarbij ik er in geslaagd was om op de eerste rij te starten werd de 1e vermelding
overschreven door een eventuele 2e vermelding wat dus niet de bedoeling is.

Als iemand mij op weg zou kunnen/willen helpen dan zou ik dat ten zeerste appreciëren.

Moest bovenstaand codeblokje onvoldoende zijn om de vraag te kunnen beantwoorden dan zal ik
mijn bestand eventjes strippen van overbodige onderdelen en alsnog een voorbeeldbestand bijvoegen.

Alvast dank op voorhand.

groetjes,
BlackDevil/Bieke

MollyVH · « **Reactie #1 Gepost op:** 10 januari 2024, 16:20:02 »

Hey Bieke,

Het 'probleem' is: als er niets op rij 1 staat krijg je met "rij = Cells(Rows.Count, fkol).End(xlUp).Row" 1 als resultaat, en dat is ook zo als enkel op rij 1 iets staat, dus met nog een if-constructie ertussen ga je dat zeker opgelost krijgen.
Ik kan het nu niet verder bekijken (moest eigenlijk al 10 minuten weg zijn

), maar dat lukt jou wel, denk ik.
Succes !

Groetjes,
Molly

BlackDevil · « **Reactie #2 Gepost op:** 10 januari 2024, 16:35:22 »

Hey Molly,

Ja, ik had er bij mijn pogingen een if-statement tussen gezet omdat ik weet dat als de eerste rij 'leeg' is de "rij = Cells(Rows.Count, fkol).End(xlUp).Row"
altijd 1 zal geven maar omdat het niet werkte ging ik ervan uit dat dat niet de oplossing was...
Maar ik had gewoon de verkeerde structuur gebruikt binnen die if-statement want het is me nu dus wél gelukt (ook ondertussen even
met iets anders bezig geweest dus was er weer met frisse moed gaan voor zitten

)
ik heb er nu dit van gemaakt :

Code: [Selecteer]

With Sheets("famnm-lijst")
  For f = 0 To UBound(arFamnm)
    On Error Resume Next
    fkol = Left(arFamnm(f), 1)
    If Application.CountIf(.Columns(fkol), arFamnm(f)) = 0 Then
      rij = .Cells(Rows.Count, fkol).End(xlUp).Row
      If rij = 1 And .Cells(rij, fkol) = "" Then
        .Cells(rij, fkol) = arFamnm(f)
      Else
        .Cells(rij + 1, fkol) = arFamnm(f)
      End If
    End If
  Next f
  .Columns("A:Z").EntireColumn.AutoFit
End With

en nu start hij netjes op de eerste rij

groetjes,
Bieke

BlackDevil · « **Reactie #3 Gepost op:** 11 januari 2024, 10:53:45 »

Goede (bijna) middag allemaal,

Ik heb nog eens een vraagje…
(omdat mijn vraag betrekking heeft op hetzelfde bestand plaats ik ze gewoon in dit topic)

Met volgende codeblok vul ik een 2-dimensionele array van een variabele range :

Code: [Selecteer]

Sub idx2totdb_p1()
Dim ws As Worksheet, begin As Long, einde As Long, arIdx2totdb() As Variant, rij As Long, i As Long, x As Long, arRijen() As Variant, arkol As Long
  With Sheets("IDX_G")
    begin = .Cells(Rows.Count, 22).End(xlUp).Row + 1
    einde = .Cells(Rows.Count, 1).End(xlUp).Row
    arkol = 15
    If einde > 1 Then
      For rij = begin To einde
        x = rij - (begin - 1) - 1
        ReDim Preserve arRijen(x)
          ReDim arIdx2totdb(1 To arkol)
          For i = 1 To 4
            arIdx2totdb(i) = .Cells(rij, i)
          Next i
          For i = 5 To arkol - 1
            arIdx2totdb(i) = .Cells(rij, i + 3)
          Next i
          arIdx2totdb(arkol) = rij
        arRijen(x) = arIdx2totdb
      Next rij
    End If
  End With
End Sub

Dit werkt perfect, de 2-D array is netjes opgevuld zoals gewenst.
Ik heb voor deze aanpak (actieve range inlezen in 2-d array) gekozen omdat ik voor diverse procedures een andere combinatie van gegevens uit deze range nodig heb en ik niet elke keer opnieuw een complete inlees-structuur wil opbouwen en laten doorlopen.
Nu wil ik voor een eerste procedure vanuit die 2-d array bepaalde gegevens in 2 nieuwe arrays stoppen.

arRijen(x)() (=bron-array)
Voor de 1e array heb ik van elke ‘x’ de volgende posities nodig : 6 – 9 – 11 – 13
Voor de 2e array heb ik van elke ‘x’ de volgende posities nodig : 7 – 8 – 10 – 12 – 14
Ook is het zo dat de gegevens voor de 2e array moeten gesplitst worden in afzonderlijke elementen.

Om de 2 arrays te maken vanuit één enkele rij(x) weet ik hoe ik dit moet doen maar gezien het hier om meerdere rijen gaat en ik nogal weinig ervaring heb met arrays zit ik hierbij dus een beetje vast…
Hoe pak ik dit het beste aan?

Dit was de wijze waarop ik de 2 arrays vulde toen ik rechtstreeks vanuit het werkblad 1 rij inlas :

Code: [Selecteer]

With Sheets("IDX_G")
    begin = .Cells(Rows.Count, 22).End(xlUp).Row + 1
    einde = .Cells(Rows.Count, 1).End(xlUp).Row
    For g = begin To einde
      arFamnm = Array(.Cells(g, 9).Value, .Cells(g, 12).Value, .Cells(g, 14).Value, .Cells(g, 16).Value)
      arrVrnm = Array(.Cells(g, 10).Value, .Cells(g, 11).Value, .Cells(g, 13).Value, .Cells(g, 15).Value, .Cells(g, 17).Value)
      For i = 0 To 4
        vrnaam = WorksheetFunction.Trim(arrVrnm(i))
        n = Split(vrnaam, " ")
        For j = 0 To UBound(n)
          ReDim Preserve arVrnm(jj)
          arVrnm(jj) = n(j)
          jj = jj + 1
        Next j
      Next i
    Next g
End With

Ik weet dat het toevoegen van een werkbestand handiger is voor de helpers maar mijn huidig bestand zou ik extreem moeten strippen hebben voor dit specifieke onderdeel waardoor het sneller ging om gewoon een klein bestandje toe te voegen met een werkblad waarop ik een aantal gegevens heb geplaatst en dan het betreffende codeblok in een module heb gestoken.

Alvast dank op voorhand.

Groetjes,
Bieke

BlackDevil · « **Reactie #4 Gepost op:** 12 januari 2024, 11:11:07 »

***update***

Omdat ik leergierig ben, nog héél veel andere procedures moet coderen en ik dus ook niet verder kan zonder die extra arrays ben ik zelf ook blijven zoeken
om het opgelost te krijgen.

Ik heb het (tijdelijk) opgelost gekregen maar (omwille van mijn beperkte kennis mbt arrays) op zéér omslachtige wijze met té veel omweggetjes m.i.
dus als er iemand toch nog wil helpen met een efficiëntere doch (voor mij) begrijpbare code dan zou ik dit zeer op prijs stellen

.

Ik heb dus volgende codeblokje toegevoegd net onder het lijntje "next rij" (van het eerste codeblokje uit mijn vorige bericht) :

Code: [Selecteer]

arFamnm = arRijen(0)(6)
arrVrnm = arRijen(0)(7)
For f = 9 To 13 Step 2
  arFamnm = arFamnm & "," & arRijen(0)(f)
Next f
For v = 8 To 14 Step 2
  arrVrnm = arrVrnm & "," & arRijen(0)(v)
Next v
For r = 1 To UBound(arRijen)
  arFamnm = arFamnm & "," & arRijen(r)(6)
  arrVrnm = arrVrnm & "," & arRijen(r)(7)
  For f = 9 To 13 Step 2
    arFamnm = arFamnm & "," & arRijen(r)(f)
  Next f
  For v = 8 To 14 Step 2
    arrVrnm = arrVrnm & "," & arRijen(r)(v)
  Next v
Next r
arFamnm = Split(arFamnm, ",")
arrVrnm = Split(arrVrnm, ",")
For i = 0 To UBound(arrVrnm)
  vrnaam = WorksheetFunction.Trim(arrVrnm(i))
  n = Split(vrnaam, " ")
  For j = 0 To UBound(n)
    ReDim Preserve arVrnm(jj)
    arVrnm(jj) = n(j)
    jj = jj + 1
  Next j
Next i

Ondanks dat het wel werkt ben ik niet echt tevreden mbt de omslachtigheid ervan, zeker als je dan de sub in zijn geheel gaat bekijken...
Ik hou namelijk van zo kort mogelijke, efficiënte en begrijpbare code

.

groetjes,
Bieke

MollyVH · « **Reactie #5 Gepost op:** 12 januari 2024, 12:19:47 »

Hey Bieke,

Mijn enige forumactiviteit gisteren is beperkt gebleven tot je post diagonaal lezen en je bijlage downloaden, het is gewoon té druk

Een momentje geleden heb ik je bestand bekeken zonder te merken dat je nog een extra post had geplaatst.
Bij dat bekijken was het me opgevallen dat je in "Sub idx2totdb_p1()" ook al een relevante omweg had gemaakt.
Die dient toch enkel om 'arRijen' te vullen, niet?
In één enkele beweging kan je dat ook met:

Code: [Selecteer]

Sub idx2totdb_p1()
Dim ws As Worksheet, begin As Long, einde As Long, arIdx2totdb() As Variant, rij As Long, i As Long, x As Long, arRijen, arkol As Long
  With Sheets("IDX_G")
    begin = .Cells(Rows.Count, 22).End(xlUp).Row + 1
    einde = .Cells(Rows.Count, 1).End(xlUp).Row
    If einde > 1 Then
      arRijen = .Cells(begin, 1).Resize(einde + 1 - begin, 17)
    End If
  End With
End Sub

Maar ik neem aan dat je nadien ook nog 'rij' nodig hebt die je in de laatste 'kolom' van die array steekt? Dan mag het worden:

Code: [Selecteer]

Sub idx2totdb_p1()
Dim ws As Worksheet, begin As Long, einde As Long, arIdx2totdb() As Variant, rij As Long, i As Long, x As Long, arRijen, arkol As Long
  With Sheets("IDX_G")
    begin = .Cells(Rows.Count, 22).End(xlUp).Row + 1
    einde = .Cells(Rows.Count, 1).End(xlUp).Row
    If einde > 1 Then
      arRijen = .Cells(begin, 1).Resize(einde + 1 - begin, 18)
      For i = begin To einde
        arRijen(i + 1 - begin, 18) = i
      Next i
    End If
  End With
End Sub

In beide gevallen zal je een paar 'kolommen' op overschot hebben in de array, maar die eten heus geen brood

Wat je er verder mee wou zag ik daarnet nog niet, maar met de code in je laatste post kom ik daar mogelijk wel achter. Nu eerst dringend boodschappen, daarna linea recta naar een vergadering, maar in de late(re) namiddag lijkt het te gaan lukken om er verder naar te kijken.

Groetjes,
Molly

BlackDevil · « **Reactie #6 Gepost op:** 12 januari 2024, 13:23:39 »

@Molly,

Hartelijk dank voor je reactie en mogelijke oplossingen tijdens je super drukke dag $_/-\o_$ ...

Indien het vullen van de array "arRijen" zo drastisch ingekort kan/zal worden dan ga ik nog wat extra informatie moeten geven

.

Zoals je zelf al wel zal gezien hebben staat er in de declaraties "Dim ws as Worksheet" en heb ik in mijn code ook "arkol = 15" staan...
Dit staat er natuurlijk niet 'zomaar'

...

Ik heb namelijk 3 werkbladen waarbij identiek hetzelfde moet gebeuren maar elk werkblad heeft een verschillend aantal kolommen...
Het begin van mijn code (waar het correcte werkblad wordt aangewezen) had ik in mijn voorbeeldbestandje weg gelaten omdat ik daarin
mbt het array-probleem maar 1 werkblad had geplaatst.

het begin van mijn echte sub idx2totdb_p1() (tem With ws) is eigenlijk het volgende :

Code: [Selecteer]

Sub idx2totdb_p1()
Dim ws As Worksheet, begin As Long, einde As Long, arIdx2totdb() As Variant, rij As Long, i As Long, x As Long, arRijen() As Variant, arkol As Long
Dim r As Long, f As Long, v As Long, k As Long, arFamnm As Variant, arVrnm() As Variant, arrVrnm As Variant, vrnaam As Variant, j As Long, jj As Long, n As Variant
  Select Case Application.Caller
    Case "g_idx2tdb"
      Set ws = Sheets("IDX_G")
      begin = .Cells(Rows.Count, 22).End(xlUp).Row + 1
      arkol = 15
    Case "h_idx2tdb"
      Set ws = Sheets("IDX_H")
      begin = .Cells(Rows.Count, 28).End(xlUp).Row + 1
      arkol = 21
    Case "o_idx2tdb"
      Set ws = Sheets("IDX_O")
      begin = .Cells(Rows.Count, 25).End(xlUp).Row + 1
      arkol = 18
  End Select
  With ws

De reden dat ik in mijn opvulcode van de array met 2 loops had gewerkt om kolommen 5, 6 en 7 uit te sluiten was omdat ik
in geen enkele procedure die moet starten vanaf deze sub de gegevens uit die 3 bewuste kolommen nodig heb. Maar zoals je zegt,
in principe kan het geen kwaad dat deze toch in de array staan, ik zal er enkel extra rekening moeten mee houden in de verdere
coderingen (met diverse loops) van de procedures die vanuit die array moeten uitgevoerd worden dat ik dan telkens die 3 elementen
in de array moet overslaan...

En inderdaad, als laatste element van arRijen() heb ik het rij-nr nodig zodat ik bij één van de 'opvolg'-procedures vanuit een ander
werkblad (totaal_db) de geconverteerde namen terug naar hun originele schrijfwijze kan omzetten.

Zoals ik in mijn vorig bericht al zei, ik heb nog héél veel andere procedures te schrijven en moet dan ook met vele zaken nu al rekening houden

Ik bestudeer van mijn kant eventjes jouw aangereikt codeblokje om te kijken in hoeverre er mbt mijn andere procedures nog ergens rekening mee gehouden moet worden.

groetjes,
Bieke

BlackDevil · « **Reactie #7 Gepost op:** 12 januari 2024, 15:02:00 »

***update***

Gezien de huidige fase van de hulp leek het mij iets praktischer voor de helpers om met het complete bestand aan de slag te kunnen gaan dus heb ik eventjes mijn echt bestand opgeschoond en voeg ik het hier toe.

Omdat ik in de werkbladmodules van de “IDX”-werkbladen alsook in de module “mod_conversies” code heb staan waarbij gebruik gemaakt wordt van een tweede bestand heb ik deze code eventjes gedeactiveerd door er commentaar van te maken.

Groetjes,
Bieke

MollyVH · « **Reactie #8 Gepost op:** 12 januari 2024, 17:13:18 »

Hey Bieke,

't Is gebeurd: ik ben nog eens thuis geraakt

Citaat

Indien het vullen van de array "arRijen" zo drastisch ingekort kan/zal worden dan ga ik nog wat extra informatie moeten geven
...staat er in de declaraties "Dim ws as Worksheet" en heb ik in mijn code ook "arkol = 15" staan...
Dit staat er natuurlijk niet 'zomaar'

Ik heb ook niet gezegd dat je mijn, op wat ik tot dan toe wist, gebaseerde code niet volgens de eisen mocht herwerken, hé

Het probleem zie ik daarmee trouwens niet, dan verander je de '18' uit mijn tweede code (vermits ook 'rij' nodig blijft) toch gewoon door een variabele ('arkol' bv.)

Uit een snelle blik op de code in je uitgebreider bestand mag ik afleiden dat de enige bedoeling van deze macro een update is van 'famnm-lijst' en 'vrnm-lijst'? Als dat klopt kijk ik wel eens waar het nog korter of efficiënter kan.

Groetjes,
Molly

BlackDevil · « **Reactie #9 Gepost op:** 12 januari 2024, 19:03:31 »

Hey Molly,

Citaat van: MollyVH op 12 januari 2024, 17:13:18

Ik heb ook niet gezegd dat je mijn, op wat ik tot dan toe wist, gebaseerde code niet volgens de eisen mocht herwerken, hé
Het probleem zie ik daarmee trouwens niet, dan verander je de '18' uit mijn tweede code (vermits ook 'rij' nodig blijft) toch gewoon door een variabele ('arkol' bv.)

ja, tuurlijk.... en ik moet sowieso ook in de bepaling van de variabele 'begin' een extra variabele gebruiken voor de kolom die de rows.count moet bepalen aangezien
deze voor elk werkblad anders is.

Citaat

Uit een snelle blik op de code in je uitgebreider bestand mag ik afleiden dat de enige bedoeling van deze macro een update is van 'famnm-lijst' en 'vrnm-lijst'? Als dat klopt kijk ik wel eens waar het nog korter of efficiënter kan.

wel, deels....
Nadat de lijsten ge-updated zijn is het de bedoeling dat er iets 'extra' gebeurd

(dit en het verdere verloop van de sub moet ik nog coderen)
Eerst en vooral moet in mijn 'wegschrijf'-code voor de lijsten nog een kleine toevoeging komen inzake (tijdelijk) opmaak, nl de tekstkleur (wordt verder in de uitleg wel duidelijk).
Indien er effectief 'nieuwe' aanvullingen zijn (dus namen die nog niet vermeld staan) dan moet er een msgbox verschijnen met de melding 'nieuwe namen te verwerken' (of iets dergelijks).
en als ik dan op 'ok' druk moet de sub (tijdelijk) verlaten worden....
Vervolgens doe ik dan de verwerking (die enkel maar handmatig kan) en ga ik via een knop op het werkblad (waarin ik de verwerking heb gedaan) terug naar de sub "idx2totdb_p1" voor het vervolg.
Indien er géén nieuwe toevoegingen werden gedaan dient de msgbox overgeslagen te worden en de sub verdergezet te worden.

De handeling die ik 'handmatig' moet uitvoeren is de vermelde namen in de lijsten kopiëren naar de werkbladen met de stam-varianten naar de correcte kolom zodat de converteercode correct uitgevoerd kan worden (vandaar dat de tekstkleur van de nieuwe toevoegingen in de lijsten tijdelijk in een opvallende kleur moet zodat ik snel de nieuwe namen terugvind).
Nadat de namen dan via de code geconverteerd zijn heb ik de geconverteerde namen + een deel van de rest van de gegevens uit 'arRijen()' nodig om de 'totaal-db' te kunnen aanvullen.

De werking is simpeler dan het lijkt maar het is gewoon wat moeilijk voor mij om het correct op deze wijze te beschrijven

.

groetjes,
Bieke

MollyVH · « **Reactie #10 Gepost op:** 12 januari 2024, 19:37:48 »

Hey Bieke,

Ik had (nu het qua agenda nog kon), na nog eens goed nagelezen te hebben, al even geanticipeerd op je volgende reactie, en dus wat aanpassingen gedaan. Op het eerste zicht zullen die niet conflicteren met je nieuwste aandachtspuntjes (oef

)

Je bestaande code heb ik telkens in commentaar laten staan, en daar telkens meteen onder mijn alternatieve aanpak. Over korter (soms een beetje, soms veel) kan geen discussie bestaan

, voor mezelf vind ik het ook duidelijker. Ik heb het enkel voor G gedaan (wat ook in je eigen code het geval was), en als dat in orde is zal daar voor H en O niet bijster veel aan toegevoegd moeten worden.

Voor de gein heb ik ook het wegschrijven naar 'famnm-lijst' met enkele regeltjes ingekort

('vrnm-lijst' is dan voor jou

)

Groetjes,
Molly

BlackDevil · « **Reactie #11 Gepost op:** 13 januari 2024, 08:16:20 »

Goedemorgen Molly,

Ik heb jouw alternatieve aanpak grondig doorgenomen en mits enkele aanpassingen en toevoegen is dit in principe volledig ok.
Althans toch voor deel 1 (vullen 'arRijen') en deel 3 (wegschrijven naar de werkbladlijsten) van de sub.

Het middelste deel (de juiste gegevens in de naam-arrays plaatsen) is zeker 'ok' voor wat de verwerking 'IDX_G' betreft maar
lijkt voor mij (met mijn beperkte kennis) iets ingewikkelder om aan te passen zodat het kan toegepast worden op de drie verschillende werkbladen.
Ik denk dat hier mijn aanpak met loops (eventueel iets anders opgebouwd dan hoe ik het had gedaan) interessanter is gezien de variatie in het aantal
kolommen dat dient ingelezen te worden bij elk werkblad. Maar zoals ik al zei is mijn veronderstelling gebaseerd op mijn eigen (beperkte) kennis van VBA.
Mogelijks is er door mensen met veel meer kennis (zoals jij oa) wel een simpele aanpassing van de "Select Case"-aanpak mogelijk.

Bij werkblad 'IDX_G' zijn er 4 kolommen met familienamen en 5 kolommen met voornamen.
Bij werkblad 'IDX_H' zijn er 7 kolommen met familienamen en 8 kolommen met voornamen.
Bij werkblad 'IDX_O' zijn er 5 kolommen met familienamen en 6 kolommen met voornamen.

Dit heb ik er nu van gemaakt in zijn geheel waarbij het middelste deel dus enkel van toepassing is op 'IDX_G' :

Code: [Selecteer]

Sub idx2totdb_p1()
Dim ws As Worksheet, bgnkol As Long, arkol As Long, begin As Long, einde As Long, arRijen, i As Long
Dim k As Long, aantal_f As Long, arfamnm(), vrnaam As Variant, n As Variant, j As Long, aantal_v As Long, arvrnm()
Dim f As Long, fkol As Variant, v As Long, vkol As Variant
Dim ftot As Long, vtot As Long, tekst As Variant
  
  Select Case Application.Caller
    Case "g_idx2tdb"
      Set ws = Sheets("IDX_G")
      bgnkol = 22
      arkol = 18
    Case "h_idx2tdb"
      Set ws = Sheets("IDX_H")
      bgnkol = 28
      arkol = 24
    Case "o_idx2tdb"
      Set ws = Sheets("IDX_O")
      bgnkol = 25
      arkol = 21
  End Select
  With ws
    begin = .Cells(Rows.Count, bgnkol).End(xlUp).Row + 1
    einde = .Cells(Rows.Count, 1).End(xlUp).Row
    If einde > 1 Then
      arRijen = .Cells(begin, 1).Resize(einde + 1 - begin, arkol)
      For i = begin To einde
        arRijen(i + 1 - begin, arkol) = i
      Next i
      For i = 1 To einde + 1 - begin
        For k = 1 To UBound(arRijen, 2)
          Select Case k
            Case 9, 12, 14, 16
              aantal_f = aantal_f + 1
              ReDim Preserve arfamnm(1 To aantal_f)
              arfamnm(aantal_f) = arRijen(i, k)
            Case 10, 11, 13, 15, 17
              vrnaam = arRijen(i, k)
              n = Split(vrnaam, " ")
              For j = 0 To UBound(n)
                aantal_v = aantal_v + 1
                ReDim Preserve arvrnm(1 To aantal_v)
                arvrnm(aantal_v) = n(j)
              Next j
          End Select
        Next k
      Next i
      ftot = 0: vtot = 0
      With Sheets("famnm-lijst")
        For f = 0 To UBound(arfamnm)
          On Error Resume Next
          fkol = Left(arfamnm(f), 1)
          If Application.CountIf(.Columns(fkol), arfamnm(f)) = 0 Then
            .Cells(1, fkol).Offset(Application.CountA(.Columns(fkol))).Font.Color = vbRed
            .Cells(1, fkol).Offset(Application.CountA(.Columns(fkol))) = arfamnm(f)
            ftot = ftot + 1
          End If
        Next f
        .Columns("A:Z").EntireColumn.AutoFit
      End With
      With Sheets("vrnm-lijst")
        For v = 0 To UBound(arvrnm)
          On Error Resume Next
          vkol = Left(arvrnm(v), 1)
          If Application.CountIf(.Columns(vkol), arvrnm(v)) = 0 Then
            .Cells(1, vkol).Offset(Application.CountA(.Columns(vkol))).Font.Color = vbRed
            .Cells(1, vkol).Offset(Application.CountA(.Columns(vkol))) = arvrnm(v)
            vtot = vtot + 1
          End If
        Next v
        .Columns("A:Z").EntireColumn.AutoFit
      End With
      If ftot > 0 Then tekst = "Er zijn nieuwe familienamen toegevoegd."
      If vtot > 0 Then tekst = "Er zijn nieuwe voornamen toegevoegd."
      If ftot > 0 And vtot > 0 Then tekst = "Er zijn nieuwe familie- & voornamen toegevoegd."
      If tekst <> "" Then
        MsgBox tekst
      Else
        idx2totdb_p2
      End If
    End If
  End With
End Sub

Ik ga het alleszins in de loop van de dag ook zelf blijven bestuderen mbt aanpassen van dat specifiek codeblok.

groetjes,
Bieke

Montagnard · « **Reactie #12 Gepost op:** 13 januari 2024, 08:54:06 »

Citaat van: BlackDevil op 13 januari 2024, 08:16:20

Mogelijks is er door mensen met veel meer kennis (zoals jij oa) wel een simpele aanpassing van de "Select Case"-aanpak mogelijk.

dit gaat al heel lang mijn petje ver te boven

....
ik denk dat je echt zal moeten terug vallen op de heel grote kennis van Molly

Grtjs,
Arnold.

MollyVH · « **Reactie #13 Gepost op:** 13 januari 2024, 11:51:26 »

Hey Bieke,

Citaat

Ik heb jouw alternatieve aanpak grondig doorgenomen en mits enkele aanpassingen en toevoegen is dit in principe volledig ok.

...aanpassingen en toevoegen waar het op dat moment nog niet over ging, denk ik dan zelf...

Citaat

Het middelste deel is zeker 'ok' voor wat de verwerking 'IDX_G' betreft maar lijkt voor mij iets ingewikkelder om aan te passen zodat het kan toegepast worden op de drie verschillende werkbladen.
Ik denk dat hier mijn aanpak met loops interessanter is gezien de variatie in het aantal kolommen

Oei, denk je dat werkelijk?

Ik heb trouwens niet geïnsinueerd dat jij dat moest doen, hé, ik wou je vooral een methode tonen om te zien of jij daar kon mee leven (ze voldoet in elk geval aan je 3 criteria "zo kort mogelijke, efficiënte en begrijpbare code"

)

Ik zag wel nog een reeks mogelijkheden om H en O zo kordaat mogelijk te implementeren, en na ampel overleg (met mezelf

) is de gosub-methode als laureaat verkozen. Ik zie je al schrikken bij de gedachte alleen maar 'arkol' is finaal afgevoerd!

Terloops: "gosub" zie ik (quasi) nooit meer in code verschijnen, terwijl dat nochtans erg nuttig kan zijn. Gewoon "uit de mode geraakt" denk ik, maar de dwarsligger in mij volgt zelden de kudde.
Voor de 3 werkbladen wordt nu een identieke range ingelezen, t.t.z. aantal rijen varieert uiteraard maar kolommen is standaard 24. Die laatste wordt gebruikt om 'rij' in op te slaan (al zie ik nog altijd niet waar of wanneer je die nog gebruikt, maar kan best geloven dat er nog code bestaat of moet komen die niet in je voorbeeldbestand zat).
Er is namelijk geen enkel argument om de 23 overige kolommen niet voor elk werkblad in je array te stoppen. Met een eenvoudige "select case" wordt daarna bepaald welke kolommen hoe moeten behandeld worden, en omdat de onderliggende code altijd eender is wordt daarheen gesprongen via 'gosub'.

De code bekijken (en testen

) zal waarschijnlijk wel weer duidelijker zijn dan mijn uitleg, dus hierbij versie 2.

Groetjes,
Molly

BlackDevil · « **Reactie #14 Gepost op:** 13 januari 2024, 12:55:46 »

Hey Molly,

Citaat van: MollyVH op 13 januari 2024, 11:51:26

Ik zag wel nog een reeks mogelijkheden om H en O zo kordaat mogelijk te implementeren, en na ampel overleg (met mezelf ) is de gosub-methode als laureaat verkozen. Ik zie je al schrikken bij de gedachte alleen maar 'arkol' is finaal afgevoerd!

Een uitbreiding van de bestaande 'select case' naar een geneste "select case" zag ik zelf ook als enige mogelijkheid om de 'select case'-aanpak te behouden maar
ik vond (totnogtoe) niet de juiste volgorde van de opbouw-structuur

.

Citaat

Terloops: "gosub" zie ik (quasi) nooit meer in code verschijnen, terwijl dat nochtans erg nuttig kan zijn. Gewoon "uit de mode geraakt" denk ik, maar de dwarsligger in mij volgt zelden de kudde.

Wel, bij de grootste procedure (namelijk de centralisatie in de 'Totaal-db') wordt de 'gosub' ook gebruikt

. In de laatste 5 jaar heb ik al meerdere versies van dit bestand met de 'totaal-db' gemaakt en elke keer blijf ik die 'gosub' gebruiken. Ik vind dit zelfs in vele gevallen een hele nuttige methode.

Citaat

Die laatste wordt gebruikt om 'rij' in op te slaan (al zie ik nog altijd niet waar of wanneer je die nog gebruikt, maar kan best geloven dat er nog code bestaat of moet komen die niet in je voorbeeldbestand zat).

Dat rij-nummer zal sowieso moeten weggeschreven worden in de 'totaal-db' om naderhand voor de uitvoer van de gezinsreconstructies de correcte namen te kunnen terughalen zoals deze in de akte vermeld stonden.
Maar ook in dit deel heb ik het rij-nummer nodig om mijn controle-kolom bij te werken.

Dit gezegd zijnde, de bijgewerkte versie van de select Case in combinatie met de gosub is wat mij betreft volledig goedgekeurd

Ik moet er nu nog enkel mijn laatste toevoegingen in verwerken (het terugzetten van de tekstkleur en het als 'verwerkt' aanduiden in de controle-kolom)
maar das maar een minuutje werk

.

Het volgende onderdeel is dan de rijen inlezen waarbij de namen vervangen worden door de conversie variant en vervolgens via tal van verschillende en complexe voorwaarden
de totaal-db aanmaken.

groetjes,
Bieke

Help!

Menu

Hulp bij posten

Zoeken

Recente topics

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

BlackDevil

vba for..next..-loop wegschrijfvraagje

MollyVH

Re: vba for..next..-loop wegschrijfvraagje

BlackDevil

Re: vba for..next..-loop wegschrijfvraagje

BlackDevil

Re: vba for..next..-loop wegschrijfvraagje

BlackDevil

Re: vba for..next..-loop wegschrijfvraagje

MollyVH

Re: vba for..next..-loop wegschrijfvraagje

BlackDevil

Re: vba for..next..-loop wegschrijfvraagje

BlackDevil

Re: vba for..next..-loop wegschrijfvraagje

MollyVH

Re: vba for..next..-loop wegschrijfvraagje

BlackDevil

Re: vba for..next..-loop wegschrijfvraagje

MollyVH

Re: vba for..next..-loop wegschrijfvraagje

BlackDevil

Re: vba for..next..-loop wegschrijfvraagje

Montagnard

Re: vba for..next..-loop wegschrijfvraagje

MollyVH

Re: vba for..next..-loop wegschrijfvraagje

BlackDevil

Re: vba for..next..-loop wegschrijfvraagje