• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

variabele functie in een Loop laten invoeren

Status
Niet open voor verdere reacties.
M

martijndib

Gebruiker
Lid geworden
9 aug 2018
Berichten
11
Hallo Help Mij´ers,

Ik ben bezig met een kleine jaarlijkse database in Excel (i know excel is geen database software maar het moet even zo).

Wat ik nu heb is de volgende Loop.

For I = 1 To 12

'Fill selection with date and move 1 down
ActiveCell.FormulaR1C1 = "=TODAY()"
ActiveCell.Offset(1, 0).Select

'insert formula to retrieve data
ActiveCell.FormulaR1C1 = _
"=SUMIFS(OTB!R316C7:R316C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
ActiveCell.Offset(1, 0).Select

Deze formule heb ik 33x moeten kopieren en plakken, omdat de R316 waarde steeds veranderd. Deze formule moet 12x in 33 regels geplakt worden.
Nu komt het lastige, na elke 3 regels, moet de R316 waarde 2 overslaan. we gaan dus van R316, R317, R318 naar R321, R322, R323. En dan dit dus tot we uitkomen bij R368.

De formule is elke 12x in de loop hetzelfde. Echter voornamelijk voor het leesgemak en het formaat van de file zou ik graag wilen dat de formule ook in een loop(33x dus) staat. Echter is het mij de pet te boven tot nu toe om deze loop in elkaar te draaien.

Wie o Wie heeft het inzicht om mij hiermee te kunnen helpen?

Met vriendelijke groet,
Martijn
 
Waarom überhaupt met VBA? Als je een echte tabel gebruikt in Excel, en de formule in de eerste rij maakt, wordt de formule automatisch meegekopieerd als je nieuwe rijen aanmaakt. Ben je gelijk klaar. En vermijd Select in dit soort loops, vertraagt alleen maar en is absoluut ook niet nodig.
Daarnaast is het natuurlijk veel mooier als je een bestandje meepost, en je code opmaakt met de CODE tag :).
 
RE:Octafish

Zelfs een uitgekleede versie van mijn bestand is 14.2MB en die lijk ik niet te kunnen uploaden. (ongetwijfeld heb je hier een tip voor)

We gebruiken een Macro omdat het originele bestand volledig samen hangt van Macro´s om onze dagelijkse rapporten samen te stellen. Door die macro´s uit te breiden zouden we dus met 1 druk op de knop deze database meteen bijwerken.

De data moet worden vergeleken met voorgaande en komende jaren (in principe bouw ik een database om trendlijnen te maken). Hierom zit er telkens een nieuwe datum regel tussen. Deze wordt gebruikt door de grafiek om de bookingpace X-n te laten zien in voorgaande jaren.

Zoals je hieronder kan zien is de Macro nogal bulkerig en onoverzichtelijk door het 33x kopieren van dezelfde regel code. Gezien de duur van dit stukje macro heb ik ook al een aantal opties in moeten bouwen met het uitzetten van de updates tot het einde zoals je kan zien.

Ik zal leren van mijn "rookie mistake" met de formats van verschillende teksten ;).

Dit is in ieder geval de volledige Macro:

Code: 
Sub Test2()
'
' test 2 Macro make The form update until today
'
Dim I As Long
Dim J As Integer
Dim H As Integer
Dim CurrentD As Date


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False

    'Set variable CurrentD to Today´s date
    CurrentD = Format(Date, "DD/MM/YYYY")
    
    'Go to Last used date and select the next cell
    Range("E2").Select
    Selection.End(xlToRight).Select
    ActiveCell.Offset(0, 1).Select
    
    'Create a Loop to keep repeating until the data for Today
    Do
    
    'Fill Cell with K
    ActiveCell.FormulaR1C1 = CurrentD
    
    
    For I = 1 To 12
    
    ActiveCell.Offset(1, 0).Select
        
        'insert formula to retrieve data
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R316C7:R316C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R317C7:R317C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R318C7:R318C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R321C7:R321C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R322C7:R322C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R323C7:R323C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R326C7:R326C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R327C7:R327C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R328C7:R328C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        
        'Transient Subtotal needs to be added
        ActiveCell.FormulaR1C1 = "=R[-3]C+R[-6]C+R[-9]C"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = "=R[-3]C+R[-6]C+R[-9]C"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = "=R[-3]C+R[-6]C+R[-9]C"
        ActiveCell.Offset(1, 0).Select
        
        'All other data needs to be retrieved
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R331C7:R331C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R332C7:R332C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R333C7:R333C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R336C7:R336C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R337C7:R337C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R338C7:R338C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R341C7:R341C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R342C7:R342C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R343C7:R343C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R346C7:R346C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R347C7:R347C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R348C7:R348C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R351C7:R351C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R352C7:R352C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R353C7:R353C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R356C7:R356C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R357C7:R357C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R358C7:R358C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R366C7:R366C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R367C7:R367C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
           "=SUMIFS(OTB!R368C7:R368C371,OTB!R306C7:R306C371,'Monthly OTB 2019'!RC1)"
        
        ActiveCell.Offset(1, 0).Select
        
      
        Next I
        
        
        
        
        
        'select all cells going UP
        ActiveCell.Offset(-1, 0).Select
        Range(ActiveCell, ActiveCell.End(xlUp)).Select
        'Execute Formula´s in Selection
        Selection.Calculate
        'Copy Selection
        Selection.Copy
        
        Loop Until Format(ActiveCell.Value, "DD/MM/YYYY") = CurrentD
    
        'Paste as values
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayStatusBar = True

MsgBox "Update Complete"
        
End Sub
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan