Som functie met VBA

[Dafje1986]

In een kolom worden van elke zes rijen in de zevende rij, de som weergegeven, simpel.

Nou word er veel gesleept met de informatie, bijvoorbeeld 4 rijen naar onder.

Als dit dan aan de rand van het bereik van de som is word deze ook verplaatst naar beneden, wat dus veroorzaakt dat de som niet klopt en er kringverwijzingen ontstaan.

Nou heb ik dit opgelost met het bereik uit te breiden boven en onder met een cel en deze te verbergen, zodat je niet meer aan de rand van het bereik kan slepen.
Alleen dit is nu te omslachtig en het veroorzaakt andere kleine problemen.

Dus nu wil ik door middel van een macro, dat hij kijkt of er in kolom A wk staat en dan in diezelfde rij in kolom B de som weergegeven word van de 6 cellen boven de som in kolom B. (dit omdat er boven in het bestand rijen verwijderd worden, de witte balk staat dus niet altijd op dezelfde plek)

een kaal voorbeeld is bijgesloten:

 

[zapatr]

Dat probleem kun je m.i. eenvoudiger oplossen door het blad (de bewuste cellen) te beveiligen.
De formules kunnen dan niet meer naar andere cellen gekopieerd worden.

 

[Dafje1986]

ja met die $ dat werkt niet, want je kopieert de som niet naar een andere cel, de som past zich aan.omdat jij de laatste cel in het bereik wegsleept en dan past de som zich gewoon aan, ongeacht of je hem vastzet of niet.

als je b.v. kolom D rij 6,7,8,9,10 als som (6:10) neemt in 11. en je sleept 10 naar 15, dan word het de som van 6 tot 15. (dus ook een kringverwijzing)

 

[Dafje1986]

Iemand een idee, als ik het blad beveilig, kan je ook niks meer invoeren enzo.

Macro lijkt mij dus het handigst...

 

[Steef13]

Met bladbeveiliging kun je nog wel ingeven. Selecteer gewoon alle cellen en zet bij de eigenschappen "Geblokkeerd"uit . Hierna selecteer je de cellen die wel beschermd moeten worden en zet je geblokkeerd weer aan.
Beveilig je blad en alleen de geblokkeerde cellen kunnen niet meer ingevuld worden...

 

[Dafje1986]

Ik heb het even geprobeerd, maar dat werkt ook niet fatsoenlijk met de manier waarop het excel bestand gebruikt zou moeten worden. Dus ik ga voor de macro, iemand een idee?


Alvast bedankt voor het meedenken

 

[Warme bakkertje]

Beste Dafje,
Dit zou je op de goede weg moeten helpen

Sub Totalen()
With Worksheets("Model 2").Range("A1:A250")
    Set c = .Find("wk", LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Offset(, 1).FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
End Sub

Mvg

Rudi

 

[Dafje1986]

Komen dan de totalen in kolom B te staan?

En wat moet je dan doen voordat de macro begint, want heb al wat geprobeerd, maar tot nu gebeurd er niet zo veel als ik een getal in kolom b invoer ofzo.

Ik snap de code niet 100%

Alvast bedankt voor je moeite! :thumb:

 

[Warme bakkertje]

Beste Dafje,
De macro doet zoals gevraagd in post#1 nl in kolom A(Range) wordt gezocht (Find) naar een cel met een bepaalde waarde("wk"). Dan wordt in de cel daarnaast(Offset) de formule (FormulaR1C1) geplaatst die de som maakt van de 6 bovenliggende rijen(Sum). Dit herhaalt hij(FindNext) totdat alle cellen in kolom A doorzocht zijn.
Wanneer en hoe de macro gestart wordt is afhankelijk van wat je zelf wil. Er zijn tal van mogelijkheden oa openen/sluiten workbook, activeren/deactiveren sheet, knop, wijzigen ve bepaalde cel, bepaalde tijd enz.

Mvg

Rudi

 

[Dafje1986]

Ja maar ik krijg de hele tijd foutmeldingen, zou je die even in het voorbeeldbestand kunnen zetten, dat hij automatisch rekent als je een getal in de B kolom invoert?

dan kom ik er dan wel uit hoop ik...

Bedankt!

 

[Warme bakkertje]

Hier kan je hopelijk weer wat verder mee

Mvg

Rudi

 

[Dafje1986]

Ja dat is goed :thumb:

Maar, één probleempje

Ik heb in het excel bestand de macro toegepast op 6 kolommen, alleen dan duurt het iedere keer vrij lang voordat hij doorgerekend is, misschien is er een makkelijkere manier dat als je op de kolom klikt hij alleen die kolom doorrekend, nou druk je op de B kolom en dan gaat hij alles opnieuw berekenen en dat duurt erg lang.

Ik heb het op deze manier gedaan:

Sub Totalen()
With Worksheets("Model 2").Range("A1:A250")
    Set f = .Find("wk", LookIn:=xlValues)
    If Not f Is Nothing Then
        firstAddress = f.Address
        Do
            f.Offset(, 1).FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
            Set f = .FindNext(f)
        Loop While Not f Is Nothing And f.Address <> firstAddress
    End If
    If Not f Is Nothing Then
        firstAddress = f.Address
        Do
            f.Offset(, 13).FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
            Set f = .FindNext(f)
        Loop While Not f Is Nothing And f.Address <> firstAddress
    End If
    If Not f Is Nothing Then
        firstAddress = f.Address
        Do
            f.Offset(, 14).FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
            Set f = .FindNext(f)
        Loop While Not f Is Nothing And f.Address <> firstAddress
    End If
    If Not f Is Nothing Then
        firstAddress = f.Address
        Do
            f.Offset(, 17).FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
            Set f = .FindNext(f)
        Loop While Not f Is Nothing And f.Address <> firstAddress
    End If
    If Not f Is Nothing Then
        firstAddress = f.Address
        Do
            f.Offset(, 18).FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
            Set f = .FindNext(f)
        Loop While Not f Is Nothing And f.Address <> firstAddress
    End If
    If Not f Is Nothing Then
        firstAddress = f.Address
        Do
            f.Offset(, 29).FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
            Set f = .FindNext(f)
        Loop While Not f Is Nothing And f.Address <> firstAddress
    End If
End With
End Sub

 

[Dafje1986]

Ik heb het al in een knop proberen te zetten, maar het werkt niet als ik er een sub commandbutton van maak.

[edit] Heb het nu bij de andere selection change gezet, en het werkt nu. Als je het vaker gebruikt word hij vanzelf sneller merk ik al.
Maar als ik het alsnog in een knop wil zetten hoe moet dat dan?

 

[Warme bakkertje]

Beste Dafje,
Wijzig je macro als volgt

Sub Totalen()
With Worksheets("Model 2").Range("A1:A250")
    Set f = .Find("wk", LookIn:=xlValues)
    If Not f Is Nothing Then
        firstAddress = f.Address
        Do
            f.Offset(, 1).FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
            f.Offset(, 13).FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
            f.Offset(, 14).FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
            f.Offset(, 17).FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
            f.Offset(, 18).FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
            f.Offset(, 29).FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
            Set f = .FindNext(f)
        Loop While Not f Is Nothing And f.Address <> firstAddress
    End If
End With
End Sub

Op deze manier moet hij de zoekfunctie maar 1 keer uitvoeren ipv 6.
Knop installeren: Beeld > Werkbalken > Formulieren > Knop > Knop op de sheet zetten en in het deelvenster de macro selecteren die uitgevoerd moet worden > OK

Mvg

Rudi