Niet logische waarden in range leegmaken VBA

[Eggie]

Goedmorgen,

ik heb in kolom A een range als volgt:

1
2
3
8
8
5

Nu wil ik graag dat de waarden 8 verwijderd worden (clearcontents) aangezien deze het logisch oplopen van de waarden onderbreken. Uiteraard bevinden deze waarden zich telkens op een andere range.

Kan iemand mij helpen dit in VBA te verwerken.

Heel erg bedankt!!

Groet, Eggie

 

[Roncancio]

Goedmorgen,

ik heb in kolom A een range als volgt:

1
2
3
8
8
5

Nu wil ik graag dat de waarden 8 verwijderd worden (clearcontents) aangezien deze het logisch oplopen van de waarden onderbreken. Uiteraard bevinden deze waarden zich telkens op een andere range.

Moet de 5 dan ook niet verwijderd worden omdat je daar 6 verwacht?

Met vriendelijke groet,


Roncancio

 

[Eggie]

Nee, wat ik eigenlijk graag wil is dat de cellen die niet logich lopen leeg gemaakt worden en daarna dit geinterpoleerd wordt. Ter verduidelijking heb ik een voorbeeld bijgevoegd.

Ik heb geen idee of zoiets mogelijk is in VBA, alvast bedankt!!

Groet EggieBekijk bijlage voorbeeld.xls

 

[Ginger]

Eggie, ff voor mijn nieuwsgierigheid... Waar heb je dit voor nodig? Zeker met die decimaal waardes tussen je integers, zie ik hier weinig toepassingen voor.

Groet, Leo

 

[Roncancio]

Sub Inconequent()
Dim lVal As Long
Dim sCol As String
Dim lRow As Long
Dim lLp As Long
Dim lBRow As Long
Dim lTel As Long
Dim lBVal As Long
Dim dCal As Double

    sCol = "[COLOR="red"][B]A[/B][/COLOR]"
    lRow = Cells(Rows.Count, sCol).End(xlUp).Row
    lVal = Range("I" & lRow).Value
    
    For lLp = 13 To 2 Step -1
        If Cells(lLp, sCol).Value >= lVal Then
            Cells(lLp, sCol).ClearContents
        Else
            lVal = Cells(lLp, sCol).Value
        End If
    Next
    
    lBRow = 2
     While lBRow <= lRow
        lTel = 1
        While Cells(lBRow, sCol).Value > ""
            lBRow = lBRow + 1
        Wend
        If lBRow < lRow Then
        
            lBVal = lBRow - 1
            While Cells(lBRow, sCol).Value = ""
                lBRow = lBRow + 1
                lTel = lTel + 1
            Wend
            dCal = (Cells(lBRow, sCol) - Cells(lBVal, sCol)) / lTel
            While lBVal < lBRow
                Cells(lBVal + 1, sCol).Value = Cells(lBVal, sCol).Value + dCal
                lBVal = lBVal + 1
            Wend
        End If
    Wend
End Sub

Enkele opmerkingen:
- verander (eventueel) de kolom waar de reeks staat. (bovenaan in de code rood weergegeven).
- Het programma begint op rij 2 en gaat door totdat de laatste cel in de kolom waar iets ingevuld is, is bereikt.

Met vriendelijke groet,


Roncancio

 

[Eggie]

Beste Roncancio,

super bedankt voor je hulp, echter als ik het script in de voorbeeld file plak en deze draai dan worden alle waarden tot de laatste verwijderd en volgt een runtime error.

Geen idee of dit eenvoudig is op te lossen..

Even een andere vraag, kun je mij zeggen waarom "lVal = Range("I" & lRow).Value" naar kolom I refereerd?

Alvast bedankt voor je hulp!!

Groet, Eggie

 

[Roncancio]

Klopt, er zat een foutje in de code.
De I-kolom wat mijn testkolom en dat was nog niet aangepast.
Nu klopt het wel.

Sub Inconequent()
Dim lVal As Long
Dim sCol As String
Dim lRow As Long
Dim lLp As Long
Dim lBRow As Long
Dim lTel As Long
Dim lBVal As Long
Dim dCal As Double

    sCol = "A"
    lRow = Cells(Rows.Count, sCol).End(xlUp).Row
    lVal = Cells(lRow, sCol).Value
    
    For lLp = 13 To 2 Step -1
        If Cells(lLp, sCol).Value >= lVal Then
            Cells(lLp, sCol).ClearContents
        Else
            lVal = Cells(lLp, sCol).Value
        End If
    Next
    
    lBRow = 2
     While lBRow <= lRow
        lTel = 1
        While Cells(lBRow, sCol).Value > ""
            lBRow = lBRow + 1
        Wend
        If lBRow < lRow Then
        
            lBVal = lBRow - 1
            While Cells(lBRow, sCol).Value = ""
                lBRow = lBRow + 1
                lTel = lTel + 1
            Wend
            dCal = (Cells(lBRow, sCol) - Cells(lBVal, sCol)) / lTel
            While lBVal < lBRow
                Cells(lBVal + 1, sCol).Value = Cells(lBVal, sCol).Value + dCal
                lBVal = lBVal + 1
            Wend
        End If
    Wend
End Sub

Met vriendelijke groet,


Roncancio

 

[Eggie]

Geweldig, bedankt!