Loop creëeren met meerdere kolommen.

[BJV]

Hallo!

Ik probeer in VBA voor excel een loop te creëeren die het volgende moet doen:

Ik heb twee kolommen (A en B) met enkele waarden:

Kolom A: 1, 4, 7, 8
Kolom B: 0, 0, 0 ,0, sum(B1:B4)

De macro moet het maximum van kolom A (in dit geval de 8 in kolom A4) bepalen, hier 2 vanaf trekken en voor de corresponderende cel in de kolom B (in dit geval dus B4) 2 optellen. De situatie is dan:

Kolom A: 1, 4, 7, 6
Kolom B: 0, 0, 0, 2

Het nieuwe maximum in kolom A is nu 7 (cel A3), dus moet de macro hier 2 vanaf trekken en 2 bij cel B3 optellen.De situatie wordt dan:

Kolom A: 1, 4, 5, 6
Kolom B: 0, 0 2, 2

Etcetera!! De loop moet stoppen als B5 de waarde 6 bereikt (dus de som van B1 t/m B4 groter/gelijk aan 6 is).

Ik had het volgende stukje code geschreven, maar dat werkt niet. Kan iemand me helpen?

Sub Optional_IPA()

Dim i As Integer
Dim j As Integer

Sheets("Optional IPA").Select

Do

If i = Application.Max(Range("A1:A4")) Then j = Range("B1:B4") + 2

Loop Until B5 >= 6
 
End Sub

 

[pasan]

dit mijn probeersel

Sub Optional_IPA()
Dim i As Integer
Dim k As Integer
Dim c

Do Until [B5].Value >= 6
i = Application.Max([A1:A4])
k = i - 2
Set c = Columns(1).Find(i, , xlValues, xlWhole)

c.Select
Selection = k
Selection.Offset(, 1) = Selection.Offset(, 1) + 2

[B5] = Application.Sum([B1:B4])
 Loop
MsgBox "Cel B5 heeft de waarde 6 bereikt"
End Sub

 

[BJV]

Het is gelukt! Thanks!

 

[pasan]

heb geprobeerd select te vermijden en "with" en "end with" te gebruiken en deze werkt

Sub Optional_IPA()
Dim i As Integer
Dim k As Integer
Dim c As Variant

Do Until [B5].Value >= 6
i = Application.Max([A1:A4])
k = i - 2
Set c = Columns(1).Find(i, , xlValues, xlWhole)
If c Is Nothing Then MsgBox "geen celwaarden gevonden": Exit Sub
With c.Cells
c.Cells = k
c.Cells.Offset(, 1) = c.Cells.Offset(, 1) + 2
End With
[B5] = Application.Sum([B1:B4])
 Loop
MsgBox "Cel B5 heeft de waarde 6 bereikt"
End Sub