Macro verkorten

[Abel Visscher]

Hallo,

Ik ben bezig mijn macro's in een programma wat aan tepassen.
Nu kom ik een macro tegen die hel lang is en eigenlijk steeds weer hetzelfde doet voor een aantal cellen in een range. Volgens mij kan dat korter dmv een for next lus?
Echter heb ik daar geen kaas van gegeten. Ik heb de code bijgevoegd.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("J5:K57,M5:N57")) Is Nothing Then Test
End Sub

Private Sub Test()
    If Range("R3") < "0" And Range("K5") > "0" Then
    Range("M5") = "Bijvullen!"
    Else: Range("M5") = Range("M5")
    End If
    If Range("Y5") < "0" And Range("K6") > "0" Then
    Range("M6") = "Bijvullen!"
    Else: Range("M6") = Range("M6")
    End If
    If Range("Y6") < "0" And Range("K7") > "0" Then
    Range("M7") = "Bijvullen!"
    Else: Range("M7") = Range("M7")
    End If
    If Range("Y7") < "0" And Range("K8") > "0" Then
    Range("M8") = "Bijvullen!"
    Else: Range("M8") = Range("M8")
    End If
    If Range("Y8") < "0" And Range("K9") > "0" Then
    Range("M9") = "Bijvullen!"
    Else: Range("M9") = Range("M9")
    End If
    If Range("Y9") < "0" And Range("K10") > "0" Then
    Range("M10") = "Bijvullen!"
    Else: Range("M10") = Range("M10")
    End If
    If Range("Y10") < "0" And Range("K11") > "0" Then
    Range("M11") = "Bijvullen!"
    Else: Range("M11") = Range("M11")
    End If
    If Range("Y11") < "0" And Range("K12") > "0" Then
    Range("M12") = "Bijvullen!"
    Else: Range("M12") = Range("M12")
    End If
    If Range("Y12") < "0" And Range("K13") > "0" Then
    Range("M13") = "Bijvullen!"
    Else: Range("M13") = Range("M13")
    End If
    If Range("Y13") < "0" And Range("K14") > "0" Then
    Range("M14") = "Bijvullen!"
    Else: Range("M14") = Range("M14")
    End If
    If Range("Y14") < "0" And Range("K15") > "0" Then
    Range("M15") = "Bijvullen!"
    Else: Range("M15") = Range("M15")
    End If
    If Range("Y15") < "0" And Range("K16") > "0" Then
    Range("M16") = "Bijvullen!"
    Else: Range("M16") = Range("M16")
    End If
    If Range("Y16") < "0" And Range("K17") > "0" Then
    Range("M17") = "Bijvullen!"
    Else: Range("M17") = Range("M17")
    End If
    If Range("Y17") < "0" And Range("K18") > "0" Then
    Range("M18") = "Bijvullen!"
    Else: Range("M18") = Range("M18")
    End If
    If Range("Y18") < "0" And Range("K19") > "0" Then
    Range("M19") = "Bijvullen!"
    Else: Range("M19") = Range("M19")
    End If
    If Range("Y19") < "0" And Range("K20") > "0" Then
    Range("M20") = "Bijvullen!"
    Else: Range("M20") = Range("M20")
    End If
end sub

Wie kan mij hiermee op weg helpen?
In het echt gaat ie nog langer door.

Groet, Abel Visscher

 

[Roncancio]

De Else heeft hier geen toegevoegde waarde.
Het lijkt mij handiger om de code te laten werken er een wijziging plaatsvindt in
het bereik ipv door het bereik te bewegen.

Op de 1e regel van de code zit een ongelijkheid omdat je zoekt in de R-kolom ipv de Y-kolom zoals in de rest van de code.
Verder moeten m.i. de haakjes weg bij de 0 anders ziet VBA het als tekst ipv als waarde.
Hoe dan ook, onderstaande code vervangt je vorige code.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("J5:Y57")) Is Nothing And Range("Y" & Target.Row - 1).Value < 0 And Range("K" & Target.Row).Value > 0 Then
    Range("M" & Target.Row + 1).Value = "Bijvullen!"
End If
End Sub

Met vriendelijke groet,


Roncancio

 

[Abel Visscher]

Hallo Roncancio,

Bedankt alvast voor je bijdrage, maar de inhoud van cell R3 speelt wel degelijk een rol.
De berekening begint met de waarde die in cell R3 staat.
Ik ga in elk geval uw gegevens verwerken.

Groeten,
Abel Visscher

 

[Abel Visscher]

Hallo Roncancio,
Uw code zet Bijvullen! een regel te laag dus dat heb ik aangepast door +1 te vervangen door +0.
Kun je mij ook vertellen zodra er Bijvullen ingevuld wordt, welk gebied er doorzocht wordt?
De macro is dan wel korter maar de berekening ddurt nu veel langer. De kolommen O t/m X hebben geen directe functie

Groeten,
Abel Visscher

 

[Roncancio]

Ik heb de code aangepast zodat ook gekeken wordt naar cel R3.
Wel opmerkelijk dat de code zoveel trager zou zijn aangezien ik geen lus gebruikt.
Bij mij werkt het namelijk niet traag.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("J5:K57")) Is Nothing Then
    If Target.Row = 5 And Range("R3") < 0 And Range("K5") > 0 Xor Range("Y" & Target.Row - 1).Value < 0 And Range("K" & Target.Row).Value > 0 Then
        Range("M" & Target.Row).Value = "Bijvullen!"
    End If
End If
End Sub

Oh ja, +0 kan je weglaten.

Met vriendelijke groet,


Roncancio

 

[Abel Visscher]

Probleem met snelhied is over??? Ik heb excel opnieuw gestart en het was over.
Bedankt.:thumb:
Ik ga er nog even mee stoeien.

Groeten,
Abel Visscher