kolom tellen tot getal is gevonden

[sebas]

Ik heb een kolom van getallen, bijv.
A1:16
A2:18
A3: 9
etc
dit gaat zo door tot een stuk of 9000 regels. Nu wil ik uit die 9000 regels ongeveer 8 (variabele)waarden vinden beginnend bij A1.
Dus stel ik moet 8 opeenvolgende waarden vinden in die 9000 regels (bijvoorbeeld 540; 600; 380;200;300;600; 350; 180) en deze van een telkens verschillende opmaakkleur geven.
Dus vanaf A1 net zo lang laten tellen tot de waarde 540 is of daar het dicht bij in de opmaakkleur rood, vervolgens A50 tot 600 in andere opmaakkleur etc.
Het aantal te vinden variable waarden kan veranderen en daarom ook de aantallen.

Is iemand die mij kan helpen met een macro?

 

[sebas]

Of misschien een andere manier?

 

[Withaar]

Ik heb een begin gemaakt.
Zit alleen zelf nog met een probleempje waardoor het nog niet werkt.
Er wordt naar het aantal variabelen gevraagd, deze worden in een array opgeslagen (A).
Vervolgens zou de marco de waarden in het arry 1 voor 1 moeten afwerken, alleen dat nu niet goed.
Helaas heb ik te weinig kennis van Excel (VBA) om precies te zien waar ik een fout maak.
Hopelijk kan iemand anders dit aanwijzen.

Sub Macro1()
'
Dim Aantal, q, x, z, start, teller, laatste_rij As Integer
Dim A(100) As Integer
Dim Allenummers As String

Do
Aantal = InputBox("Voer aantal te zoeken waarden op", "Aantal", Aantal)
If Aantal = "" Then Exit Do
Exit Do
Loop

For q = 1 To Aantal
Do
A(q) = InputBox("Nummer " & q, "Nummer invoeren", A(q))
Exit Do
Loop

Next q

For q = 1 To Aantal

Allenummers = Allenummers & A(q) & Chr(13)
Next q

msg = "Is dit correct?" & Chr(13) & Allenummers
buttonstyle = vbYesNoCancel + vbDefaultButton1 + vbQuestion
Select Case MsgBox(msg, buttonstyle, "Combinaties zoeken")
Case vbYes
GoTo 5
Case vbNo
Case vbCancel
End Select
GoTo 20
5:
x = 1
start = x
teller = 0
q = 1
10:
teller = teller + Range("A" & x).Value
If teller >= A(q) Then
Range("A" & start & ":A" & x).Select
With Selection.Interior
.ColorIndex = z Mod 3 + 4
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
Range("B" & x - 1).Value = teller - Range("A" & x).Value
End With
teller = 0
start = x
z = z + 1
x = x - 1
End If
x = x + 1
q = q + 1
If q >= Aantal Then GoTo 20
GoTo 10
20:
End Sub


De basis is deze macro;
Sub Macro1()
'
Dim x, z, start, teller, laatste_rij As Integer
x = 1
start = x
teller = 0

10:
teller = teller + Range("A" & x).Value
If teller > 100 Then
Range("A" & start & ":A" & x).Select
With Selection.Interior
.ColorIndex = z Mod 3 + 4
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
Range("B" & x - 1).Value = teller - Range("A" & x).Value
End With
teller = 0
start = x
z = z + 1
x = x - 1
End If
x = x + 1
If x > 200 Then GoTo 20
GoTo 10
20:
End Sub

Deze telt telkens tot 100 en houd bij regel 200 op.

 

[Withaar]

Hier nog even een bijlage met de 'basis' macro.

 

[sebas]

Bedankt Withaar!
Voor de genomen moeite. Zelf ben ik helemaal niet goed in VBA. Wel een boek gekocht om het te leren, maar kunnen is het nog niet. Ik ga morgen op kantoor kijken of ik er wat mee kan.

Nogmaal bedankt.

 

[Withaar]

Tja, helaas heeft er nog niemand gereageerd op mijn oproep er ook nog even naar te kijken.
Zal zelf ook nog eens een poging doen.

 

[Withaar]

Ben iets verder gekomen, de macro loopt nu iets beter.
Alleen de laaste waarde gaat niet goed en de marco loopt daarna vast.

Je kunt echter als je 6 getallen zoekt er 7 opgeven, de laatste maak je dan gewoon weer wit...

Blijft voor mij ook een uitdaging deze goed werkend te krijgen, probleem lijkt nu met name op het op tijd stoppen van de macro te zijn.

Sub Macro1()
'
Dim Aantal, q, x, z, start, teller, laatste_rij As Integer
Dim A(100) As Integer
Dim Allenummers As String

Do
Aantal = InputBox("Voer aantal te zoeken waarden op", "Aantal", Aantal)
If Aantal = "" Then Exit Do
Exit Do
Loop

For q = 1 To Aantal
Do
A(q) = InputBox("Nummer " & q, "Nummer invoeren", A(q))
Exit Do
Loop

Next q

For q = 1 To Aantal

Allenummers = Allenummers & A(q) & Chr(13)
Next q

msg = "Is dit correct?" & Chr(13) & Allenummers
buttonstyle = vbYesNoCancel + vbDefaultButton1 + vbQuestion
Select Case MsgBox(msg, buttonstyle, "")
Case vbYes
GoTo 5
Case vbNo
Case vbCancel
End Select
GoTo 20
5:
x = 1
start = x
teller = 0
q = 1
10:
teller = teller + Range("A" & x).Value
Range("C1").Value = q
If teller >= A(q) Then

If q > Aantal Then GoTo 20

Range("A" & start & ":A" & x - 1).Select

With Selection.Interior
.ColorIndex = z Mod 3 + 4
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic

Range("B" & x - 1).Value = teller - Range("A" & x).Value

q = q + 1

End With

teller = 0
start = x
z = z + 1
x = x - 1

End If

x = x + 1
GoTo 10
20:
End Sub

 

[Withaar]

Hier mijn test bestandje, met de macro zoals hij nu is.
De butten start de marco, is nu iets uitgebreider dan in bovenstaande mail en met wat commentaar voorzien.
(voor de liefhebbers )

P.s. kies gewoon voor beëingen als je de foutmelding van de marco krijgt.
Het array loopt van 0 (niet gebruikt) t/m 100.
Als q 101 is loopt de macro vast.
N.b. voor 'wijzneuzen', deze waarde ophogen is niet de oplossing...

 

[sebas]

Hallo Withaar
Bedankt dat je zoveel moeite neemt.

De macro stopt bij de regel
If teller >= A(q) Then

en daaronder staat
If q > Aantal Then GoTo 20

Ik zei al dat mijn kennis beperkt is, maar na het woordje Then verwacht ik een actie zoals in de 2e regel tw GoTo.

Is dat misschien de reden dat foutopsporing bij die regel stopt?

Grtjs

 

[Withaar]

Nee dat zal het niet zijn.
Alles na te if..then wordt uitgevoerd tot er een end if in de code staat (een aantal regels verder op).
De regel met de if .. goto zorgt er voor dat er vroegtijdig uit deze eerst if gesprongen kan worden.

N.b. de eerste if then werkt wel goed, de tweede juist niet...
Eigenlijk zou de macro netjes moeten stoppen als q, de variable die ik gebruik om één voor één de ingevoerde getallen af te werken groter is geworden dan het aantal getallen (zoekwaarden) dat aan het begin opgegeven is.

P.s. vindt dit gewoon een leuke uitdaging hoor.
Zijn voor mij ook de eerste stapjes op VBA gebied...

Kun je de marco nu al wel gebruiken (of niet, moeten er andere mensen mee werken?) voor je probleem?

 

[sebas]

Zijn voor mij ook de eerste stapjes op VBA gebied... ?!

I'm impressed:thumb:

De macro is zeker te gebruiken en ik zal de vraag de status opgelost geven.

Mocht er later iemand (of jij) zijn die verbeteringen heeft dan hou ik me aanbevolen.

Bedankt Withaar!

 

[Hans123]

Een beetje laat, maar als ik de vraag goed begrijp zou bijgaand bestand een beetje uit moeten voeren wat je wilt.

Het is het bestand van withaar, een beetje aangepast.
Het grootste probleem in de versie van withaar was dat een inputbox een string als resultaat geeft en geen getal. Hierdoor loopt het testen op een waarde niet altijd goed.

Tevens heb ik alle goto regels verwijderd, persoonlijk vind ik het erg lastig lezen. Je moet maar zien wat je er mee doet.