Loop for met veranderende startcel per rij

Status
Niet open voor verdere reacties.

MVincke

Nieuwe gebruiker
Lid geworden
29 jan 2020
Berichten
1
Hallo,

Met onderstaande code loop ik door elke rij. In elke rij moet
- dim ra = gezocht worden naar de waarde "1",
- dim duur = vanaf de cel waarin de "1" staat moet dan een selectie gemaakt worden van een aantal cellen - dat aantal wordt bepaald door een waarde in een andere cel
- die cellen moeten dan groen gekleurd worden

Dit lukt ... bijna. Echter de startcel verandert niet per rij, maar lijkt de te blijven zoals ze gevonden was voor de eerste rij of zoekresultaat.

Code:
Sub metForLoop()

nRows = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To nRows

'duur halen uit kolom D als var
'ra als start cel
Dim duur As Integer
Dim ra As Variant

'START CEL: zoek in F2 tot Z2 naar eerst 1
    Set ra = Range(Cells(i, 6), Cells(i, 100)).Find(What:=1)

'DUUR: ophalen uit D2
    duur = Cells(i, 4).Value

'EIND CEL en BEREIK - dynamisch obv duur bv Fi + duur kolommen
    ra.Select
    Selection.Resize(Selection.Rows.Count, _
    Selection.Columns.Count + duur).Interior.Color = RGB(102, 204, 0)
    
Next

End Sub
 
Met een voorbeeldje gaat het een stuk makkelijker; we zien graag wat er gebeurt. En niemand heeft tijd om zelf eerst data in te gaan kloppen :) (hoop ik dan toch ;))
 
Met een beetje rommelen met willekeurige cellen met getallen loopt deze code in ieder geval door de juiste rijen heen, tot-ie vastloopt. Maar wellicht dat het bij jou wel goed werkt.
Code:
Sub metForLoop()
Dim duur As Integer, nRows As Integer, i As Integer
Dim ra As Range
    nRows = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To nRows
        'START CEL: zoek in F2 tot Z2 naar eerst 1
        Set ra = Range(Cells(i, 6), Cells(i, 100)).Find(What:=1)
        duur = Cells(i, 4).Value
        'EIND CEL en BEREIK - dynamisch obv duur bv Fi + duur kolommen
        With ra
            .Resize(.Rows.Count, .Columns.Count + duur).Interior.Color = RGB(102, 204, 0)
        End With
    Next
End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan