Foutmelding formule berekening binnen een bepaald bereik

Status
Niet open voor verdere reacties.
R

Robert Smidt

Gebruiker
Lid geworden
26 mei 2009
Berichten
901
Beste Helpmij'ers,

Ik heb een foutmelding in een code. Ik wil nl. één berekening die van toepassing is voor de regels 16 t/m 23. De code is:

Code: 
    Dim cell As Range
    For Each cell In Range("J16:J23")
    If cell.Value Like "Nee" Then
        ActiveSheet.Unprotect
        cell.Offset(, 1) = "" 'K
        cell.Offset(, 7) = "" 'Q
        cell.Offset(, 8) = "" 'R
        cell.Offset(, 13) = "" 'W
[COLOR="#FF0000"]        If cell.Value Like Range("P16:P23") <> [kmopbrengst] * cell.Value Like Range("O16:O23") Then[/COLOR]
            cell.Offset(, 0) = [kmopbrengst] * cell.Value Like Range("O16:O23")
            ActiveSheet.Unprotect
        End If
    End If
    Next

De regel in het rood geeft bij mij een foutmelding (wordt geel gearceerd), echter geeft geen tekst wat er fout is. Hetgeen er boven staat gaat overigens goed!
Het is de bedoeling dat binnen het bereik (regel 16 t/m 23) gekeken wordt of in de betreffende regel de waarde in kolom P niet overeenkomt met de waarde in kolom O * €0.19 (kmopbrengst).
Wanneer de uitkomst niet waar is moet deze kolom P vullen d.m.v. waarde in kolom O * €0.19 (kmopbrengst)

Wat doe ik fout?

Alvast heel erg bedankt.

Robert
 
Iets in die richting?
Code: 
Sub dotchie()
Dim rCell As Range
Dim rRng As Range
Set rRng = Range("J16:J23")
    For Each rCell In rRng.Cells
    If rCell.Value Like "Nee" Then
        ActiveSheet.Unprotect
        rCell.Offset(, 1) = "" 'K
        rCell.Offset(, 7) = "" 'Q
        rCell.Offset(, 8) = "" 'R
        rCell.Offset(, 13) = "" 'W
        If rCell.Offset(, 6).Value <> [kmopbrengst] * rCell.Offset(, 5).Value Then
        rCell.Value = [kmopbrengst] * rCell.Offset(, 5).Value
        ActiveSheet.Protect
        End If
    End If
    Next
End Sub
 
Volgens mij zit jij bijna goed, alleen dat hij de uitkomst nu in kolom J zet i.p.v. kolom P.
 
Best Robert,
Dit komt uit uw code
Code: 
cell.Offset(, 0)
Dit is kolom J volgens uw code
Maak er dan het volgende van
Code: 
rCell.(Offset(,6).value van ipv rCell.Value
net boven ActiveSheet Protect
 
Hij geeft nu een compileerfout: syntaxisfout
Code: 
            rCell.(Offset(,6).value = [kmopbrengst] * rCell.Offset(, 10).Value
 
Ik ben aan het experimenteren gegaan en de code werktl
Code: 
            rCell.Offset(, 6).Value = [kmopbrengst] * rCell.Offset(, 5).Value

Wat ik alleen vreemd vind wanneer ik de waarden wijzig, deze de uitkomst niet aanpast. Ik moet eerst in de betreffende regel willekeurig in een cel een enter geven voordat deze de uitkomst aanpast. Dit wou ik juist voorkomen door de regel ervoor

Code: 
            If rCell.Offset(, 6).Value <> [kmopbrengst] * rCell.Offset(, 5).Value Then
 
Robert,
Code: 
 rCell.(Offset(,6).value = [kmopbrengst] * rCell.Offset(, [COLOR="#FF0000"]10[/COLOR]).Value
Waar haal je nu weer die 10 vandaan? Dit is kolom T.
Jij spreekt alleen over kolom J,P en O in uw eerste stukje code.
 
De waarde die in kolom O staat (totaal aantal kilometers), dat is nl. de uitkomst van Kolom M (eindstand kilometers) - Kolom L (beginstand kilometers). Dit totaal moet vervolgens vermenigvuldigd worden door 19 cent en dat is de uitkomst in kolom P.

Ik begrijp overigens niet wat je bedoeld met van waaruit deze aangeroepen wordt. Wil je graag alle voorgaande codes

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Range("d16:y23"), Target) Is Nothing Then
    Application.EnableEvents = False
 
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
dat bedoelde ik met hoe wordt je code aangeroepen.
 
Is dat van mij niet juist en wat kan ik hier aan doen dat de code actief blijft bij wijzigingen in de berekening?
 
Waarom plaats je de volledige code niet? En dan ook gelijk maar het bestandje waar het om gaat.
 
Het bestand is helaas echt veel te groot (zelfs ingepakt), de code wil ik vanzelfsprekend bij deze mee sturen.

Code: 
'P E R S O O N L I J K E  I N S T E L L I N G
'Versie 2.2
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Range("d16:y23"), Target) Is Nothing Then
    Application.EnableEvents = False

    'Hoofdletters
    [d16:d23] = [index(upper(d16:d23),)] 'proper = hoofdletters alle woorden
    [e16:f23] = [index(proper(e16:f23),)]

    ' Merk, type, aanschafdatum, einddatum, zakelijk, bijtelling, cataloguswaarde, beginstand, eindstand invoerten
    If Range("D" & Target.Row) <> "" And Range("E" & Target.Row) = "" Then Range("E" & Target.Row) = Format(InputBox("Vermeld hier het merk van het betreffende voertuig in:!"))
    If Range("E" & Target.Row) <> "" And Range("F" & Target.Row) = "" Then Range("F" & Target.Row) = Format(InputBox("Vermeld hier het type van het betreffende voertuig in:!"))
    If Range("F" & Target.Row) <> "" And Range("G" & Target.Row) = "" Then Range("G" & Target.Row) = Format(InputBox("Vermeld hier de datum wanneer het voertuig ter beschikking is gesteld! (bijv. 1-1 OF aanschafdatum)                                                    VB: 4-5 = (4 mei dit jaar) "), "MM/DD/YYYY")
    If Range("G" & Target.Row) <> "" And Range("H" & Target.Row) = "" Then Range("H" & Target.Row) = Format(InputBox("Vermeld hier de laatste datum dat het voertuig ter beschikking wordt gesteld! (bijv. datum verkoop) OF anders 31-12                                    VB: 4-5 = (4 mei dit jaar) "), "MM/DD/YYYY")
    
    'deze code tzt in thisworkbook zetten heeft betrekking op mutaties in het nieuwe jaar t.b.v. van het vorige jaar!
    If Range("L3") > Range("F2") And Range("S" & Target.Row) = "" Then Range("S" & Target.Row) = Format(InputBox("Tel alle btw-bedragen van de rekeningen en brandstofbonnen van dit voertuig bijelkaar op en vermeld hier het bedrag aan betaalde BTW!"))

    'Keuze zakelijk of privé
    If LCase(Cells(Target.Row, 8)) <> "" And LCase(Cells(Target.Row, 9)) = "" Then Cells(Target.Row, 9) = IIf(MsgBox("Betreft dit een voertuig dat op naam van het bedrijf staat?", vbYesNo + vbQuestion) = vbYes, "Ja", "Nee")
    If LCase(Cells(Target.Row, 9)) = "nee" Then Cells(Target.Row, 10) = "Nee"
    If LCase(Cells(Target.Row, 9)) = "ja" And LCase(Cells(Target.Row, 10)) = "" Then Cells(Target.Row, 10) = IIf(MsgBox("Rij je PRIVE méér dan 500 km per jaar?", vbYesNo + vbQuestion) = vbYes, "Ja", "Nee")
    
    'Keuze wanneer er een bijtelling is
    If Range("J" & Target.Row) = "Ja" Then 'And Range("K" & Target.Row) = "" Or Range("Q" & Target.Row) = "" Then
        ActiveSheet.Unprotect
        Range("P" & Target.Row) = ""
        Range("S" & Target.Row) = ""
        If Range("J" & Target.Row) = "Ja" And Range("K" & Target.Row) = "" Then Range("K" & Target.Row) = Format(InputBox("VERMELD HIER DE CATALOGUSWAARDE (incl. btw, bpm en accessoires vanuit de fabriek) van het betreffende voertuig!"))
        If Range("J" & Target.Row) = "Ja" And Range("Q" & Target.Row) = "" Then Range("Q" & Target.Row) = Format(InputBox("VERMELD HIER HET BIJTELLINGSPERCENTAGE IB (4%, 22% of 35% oldtimer)van het betreffende voertuig!")) / 100
        If Range("Q" & Target.Row) <> "" And Range("R" & Target.Row) = "" Then Range("R" & Target.Row) = (Range("K" & Target.Row) * (Range("q" & Target.Row)))
        If Range("W" & Target.Row) = "" Then Range("W" & Target.Row) = Format(InputBox("VERMELD HIER HET BIJTELLINGSPERCENTAGE BTW (Indien er btw en bpm bij aanschaf in aftrek is gebracht: Vermeld dan 2,7%, anders 1,5%.)")) / 100
        ActiveSheet.Protect
     End If
       
    
    

    
 [COLOR="#FF0000"]   'Keuze wanneer er geen bijtelling is
    Dim rCell As Range
    Dim rRng As Range
    Set rRng = Range("J16:J23")
        For Each rCell In rRng.Cells
        If rCell.Value Like "Nee" Then
            ActiveSheet.Unprotect
            rCell.Offset(, 1) = "" 'K
            rCell.Offset(, 7) = "" 'Q
            rCell.Offset(, 8) = "" 'R
            rCell.Offset(, 13) = "" 'W
            If rCell.Offset(, 6).Value <> [kmopbrengst] * rCell.Offset(, 5).Value Then
            rCell.Offset(, 6).Value = [kmopbrengst] * rCell.Offset(, 5).Value
            ActiveSheet.Protect
            End If
        End If
        Next[/COLOR]

End If








'G R O O T B O E K R E K E N I N G E N
If Range("b42") = "" Then Range("b42") = "7950"

'BTW-tariefvermelding t.b.v. de opbrengsten
If Not Intersect(Target, Range("a43:e58")) Is Nothing Then
   With Target
        If Range("D" & Target.Row) = "" And Range("c" & Target.Row) <> "" Then Range("D" & Target.Row) = Range("G8")
   End With

  'Indien de omschrijving leeg is, kolom b ook leeg maken.
  If Range("c" & Target.Row) = "" And Range("d" & Target.Row) <> "" Then Range("d" & Target.Row).ClearContents

End If

'Dim cell As Range
'For Each cell In Range("c45:c58")
For Each cell In Range("c" & Target.Row)
If cell.Value Like "*Marge*" Or cell.Value Like "*marge*" Then MsgBox ("U hebt een opbrengst waar 'Marge' in voorkomt, hier mogen niet meer van aangemaakt worden! Wanneer u hier al één van heeft, wijzig deze dan in een ander soort opbrengst!!!")
Next

'Boeknummers aanmaken voor alle grootboekrekeningen
If Not Intersect(Target, Range("a43:e145")) Is Nothing Then
        With Target
        
        If Range("c" & Target.Row) <> "" And Range("b" & Target.Row) = "" Then
            Range("b" & Target.Row) = Range("b" & Target.Row - 1) + 50
        End If
        End With

        'Indien de omschrijving leeg is, kolom b ook leeg maken.
        If Range("c" & Target.Row) = "" And Range("b" & Target.Row) <> "" Then Range("b" & Target.Row).ClearContents
End If
    
       
    Application.EnableEvents = True
  
 ' End If

End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan