Veel code voor telkens (bijna) dezelfde handeling

Status
Niet open voor verdere reacties.

harrybrinkman

Gebruiker
Lid geworden
7 nov 2019
Berichten
95
Toppers,

Ik heb een werkblad "Totalen" en daarop komen middels formules de totalen van een planning te staan op basis van een teamnaam. Dus zodra ik de teamnaam wijzig zoekt ie de totalen van dat team. Ik heb 28 teams. Nu maak ik een exportbestand (=platte tekst, zonder opmaak en zonder formules) om te delen met een collega die met die cijfers aan de gang gaat. Nu heb ik daarvoor met mijn zeer beperkte VBA kennis een module gemaakt die bovenstaande handeling 28 keer uitvoert en dit keurig onder elkaar zet op een Exportblad.
Wat ie doet is teamnaam 1 invullen op het tabblad "Totalen" (B6), deze toont vervolgens de totalen (C7:NP11) en kopieert/plakt deze als waarden op het exportblad (C3:NP7). Vervolgens vult ie teamnaam 2 in en kopieert dit naar exportblad (C9:NP13) etc.etc. Dit doet ie 28 keer achter elkaar.

Ik vroeg me af of dit ook korter kan worden geprogrammeerd? Dus ipv. 28 keer code, iets wat zichzelf 28 keer herhaalt? Ik gebruik de volgende code:

Code:
    Sheets("Totalen").Range("B6").Value = Sheets("Definities").Range("C1").Value
    Sheets("Totalen").Select
    Range("C7:NP11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Export").Select
    Range("C3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Totalen").Range("B6").Value = Sheets("Definities").Range("C2").Value
    Sheets("Totalen").Select
    Range("C7:NP11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Export").Select
    Range("C9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Totalen").Range("B6").Value = Sheets("Definities").Range("C3").Value
    Sheets("Totalen").Select
    Range("C7:NP11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Export").Select
    Range("C15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

etc.etc.etc
 
Ik ben geen held in Excel en VB, maar in de praktijk gebruik je altijd functies als je een standaard procedure wilt maken.
Lees hier meer erover: https://trumpexcel.com/user-defined-function-vba/

(Tja, ik kan er ook niks aan doen dat die site Trump-excel heet :p)
 
Laatst bewerkt:
Waarom zet je in het exportblad niet gewoon formules ?
Waarom plaats je hier geen voorbeeldbestand ?
 
Laatst bewerkt:
SNB,

Voorbeeldbestand: Het door mij geschetste probleem is onderdeel van een groot excel bestand, het werkblad "totalen" is gevuld met formules die weer gegevens halen uit 13 verschillende andere werkbladen, die ook weer vol formules staan. Ik kan er niet zomaar een paar bladen uit halen voor een voorbeeldje want dan werkt de boel niet meer. Het hele bestand delen is onbespreekbaar voor mijn werkgever. Ik begrijp dat een voorbeeld bestand duidelijker is, maar dat gaat em ff niet worden. Juist daarom heb ik die code meegestuurd.

Op het werkblad "totalen" kies ik eerst een team en vervolgens worden de totalen berekend, dat gebeurt in 5 regels in 365 kolommen, dik 1800 formules dus. Als ik een exportbestand wil maken met formules moet ik dat dus x 28 doen, dat kost mega veel rekenkracht. Daarom laat ik VBA dat in 28 kleine stapjes doen. Het enige wat ik wilde weten is of ik die 28 blokjes code niet nog wat kon inkorten.

In elk geval bedankt voor de moeite,

Harry
 
Heb je wat aan mijn link?
 
Waarom maak je gebruik van een openbaar forum, dat bedoeld is om van elkaar te leren als het teveel moeite is om anderen in gelegenheid te stellen je te helpen aan de hand van een voorbeeldbestand ? Als advies hier gratis is mag er van jouw kant ook wel wat tegenover staan.
Heb je zo'n armlastige werkgever ?
 
@Octa,

Op naar de vervolgvraag.....
 
Code:
Sub Harry()
   With Sheets("Totalen")                        'dat werkblad
      For i = 1 To 28                            '28 loops
         .Range("B6").Value = Sheets("Definities").Range("C" & i).Value   'iets invullen
         .Range("C7:NP11").Copy                  'bron
         Sheets("Export").Range("C" & i * 6 - 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      Next
   End With
End Sub
maar eigenlijk hoef je geen copy-paste, enkel de waarden overnemen ...
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan