Inkorten van vba codes

[klitzy]

Goedenavond,

Ik ben bezig met het maken van een model en heb daarbij ook veel codes die eigenlijk steeds hetzelfde doen. Ik vraag me af hoe de experts hiermee omgaan. Anders gezegd: hoe kan ik mijn vba modules overzichtelijker maken?

Voorbeeldje van een gedeelte van een sub:

If Range("H5").Value = 2 Then   'database - t.g.v. extra rij.

    If Range("A2").Value = 1 Then
        MsgBox ("Niet alle produkten zijn ingeklapt (de 'plusjes')")
    Else
                
        Selection.AutoFilter Field:=2

        Range("TellerA").Copy
        Range("TellerB").PasteSpecial Paste:=xlPasteFormulas
        Range("TellerB").Copy
        Range("TellerB").PasteSpecial Paste:=xlValues

        Range("thA").Copy
        Range("thB").PasteSpecial Paste:=xlPasteFormulas
        Range("thB").Copy
        Range("thB").PasteSpecial Paste:=xlValues
        Range("dbB").Copy
        Range("dbB").PasteSpecial Paste:=xlValues

        Range("Filter1A").Copy
        Range("Filter1B").PasteSpecial Paste:=xlPasteFormulas
        
        Range("thcw").Value = Range("thcf").Value
        Selection.AutoFilter Field:=2, Criteria1:=Array("0", "1", "2", "3"), Operator:=xlFilterValues

        Range("ProdnrA").Copy
        Range("ProdnrB").PasteSpecial Paste:=xlPasteFormulas
        Range("ProdnrB").Copy
        Range("ProdnrB").PasteSpecial Paste:=xlValues
    
    End If
End If

Een formule moet gekopieerd worden en daarna op waarde geplakt, en dat geldt voor nogal wat selecties. Zou iemand mij, beginnend VBA-er, een tip kunnen geven?

Alvast bedankt!

Groet,
Maarten

 

[Joske2000]

Hi Maarten,

Dit

        Range("TellerA").Copy
        Range("TellerB").PasteSpecial Paste:=xlPasteFormulas
        Range("TellerB").Copy
        Range("TellerB").PasteSpecial Paste:=xlValues

kan je al inkorten naar :

Range("TellerB") = Range("TellerA").Value

Groet,

Joske

 

[VenA]

Ik denk het wel. Maar als je een halve code plaatst zonder voorbeeldbestand gaat het gokken worden en wordt je denk ik niet snel geholpen.

Range("thA").Copy
        Range("thB").PasteSpecial Paste:=xlPasteFormulas
        Range("thB").Copy
        Range("thB").PasteSpecial Paste:=xlValues

Maakt het het ook niet veel duidelijker.

 

[klitzy]

Persoonlijk dacht ik dat het toevoegen van een voorbeeldbestand niet van toegevoegde waarde zou zijn, maar ik begrijp met de post van joske2000 dat het toch noodzakelijk is. Joske2000: als je het voorbeeldbestand opent, zul je zien dat de door jou aangedragen oplossing geen soelaas biedt.

Bekijk bijlage voorbeeldbestand inkorten VBA.xlsm


In het bestand zie je links twee kolommen die input is voor de kolom rechts. De formule bevindt zich alleen in de bovenste cel en heeft de naam TellerA. Teller B is een onderliggend bereik en daarin wil ik geen formules, maar harde waarden. Elke keer als in de kolommen links iets verandert (extra activiteit wordt ingevoegd bijvoorbeeld), kunnen de waarden in de kolom rechts worden geactualiseerd met de knop 'teller'.

Ben benieuwd, alvast dank voor in ieder geval het geduld!

Mvg,
Maarten

 

[Haije]

volgens mij volstaat dit:

Range("tellerA").Copy Range("tellerB")
Range("tellerB") = Range("tellerB").Value

 

[klitzy]

Haije!
Dat scheelt in ieder geval 50%

Ik zet de post nog even niet op opgelost, want hoewel dit voor 1 bereik de kortste notatie is, ben ik op zoek naar een code die deze bewerking voor verschillende bereiken in 1 keer kan doen - ik heb namelijk nogal wat bereiken benoemd

 

[Haije]

post dan eens een voorbeeld dat beter bij jouw situatie past?

 

[klitzy]

Haije,

Zie bijgaand. Ik heb het versimpeld. Om voor mij moverende redenen wil ik de kolommen niet clusteren en als 1 bereik benoemen...

Bekijk bijlage voorbeeldbestand inkorten VBA 2.xlsm

Hoor graag!

 

[Haije]

klitzy,

kijk eens in de bijlage en probeer de nieuwe knop eens uit.

 

[klitzy]

Haje,

Ja dit is dus wel waar ik naar op zoek was. Ik ben onder de indruk. De (afgeslankte) code plaats ik nog even hieronder voor de 'snelle zoekers', die geen zin hebben om het bestandje te downloaden:

Sub teller_hs()
Range("A1").Select
Application.ScreenUpdating = False
Range("HA").Select: GoSub verwerk:
Range("IA").Select: GoSub verwerk:
Range("JA").Select: GoSub verwerk:
Range("KA").Select: GoSub verwerk:
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "Teller_hs uitgevoerd!"
Exit Sub
verwerk:
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FillDown
    ActiveCell.Offset(1).Select
    Range(Selection, Selection.End(xlDown)) = Range(Selection, Selection.End(xlDown)).Value
Return
End Sub

Zou je me in een paar zinnen nog de achterliggende gedachte kunnen uitleggen? Bijv.: wat is GoSub?

 

[VenA]

Het kan nog wel een beetje korter hoor:

Sub teller()
namen = "TellerA,AA,BA,CA,DA,EA,FA,GA,HA,JA,KA"
Naam = Split(namen, ",")
For i = LBound(Naam) To UBound(Naam)
    Range(Naam(i)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FillDown
    ActiveCell.Offset(1).Select
    Range(Selection, Selection.End(xlDown)) = Range(Selection, Selection.End(xlDown)).Value
Next i
End Sub

Het stukje onder de For i heb ik even overgenomen van @Haje. Ook dit kan eenvoudiger en werkt denk ik niet correct. Ik had even geen zin om het bestandje te downloaden om het te testen!

 

[klitzy]

Wat een geweldige adviezen. Voor mij erg nuttig, voor anderen waarschijnlijk ook... Bedankt Haije en VenA!

 

[Warme bakkertje]

Of deze

Sub tst()
    For Each it In Array("tellerA", "AA", "BA", "CA", "DA", "EA", "FA", "GA", "HA", "IA", "JA", "KA")
        With Range(it)
            .Resize(Range(it).CurrentRegion.Rows.Count).FillDown
            .Offset(1).Resize(Range(it).CurrentRegion.Rows.Count - 1).Value = Range(it).Offset(1).Resize(Range(it).CurrentRegion.Rows.Count - 1).Value
        End With
    Next
End Sub

 

[klitzy]

Met ook de bijdrage van Warm bakkertje is wat mij betreft mijn vraagstelling voldoende belicht door de vakbekwame forumleden van helpmij, ik sluit de thread.

Allen erg bedankt voor het meedenken. Luv you :shocked: