Cel kleuren obv waarde

Status
Niet open voor verdere reacties.
L

leonhnoel

Gebruiker
Lid geworden
4 mei 2016
Berichten
58
Ik heb een bestand waarin een planning is opgenomen.

Vanaf kolom H beginnen de diverse werkstations met daarin het bewerkingsvolgordenummer en de bewerkingstijd.
Nu wil ik graag in iedere rij de twee cellen die corresponderen met het laagste bewerkingsvolgordenummer automatisch kleuren.

De bewerkingsvolgorde nummers lopen van 1 tot 80 ("B:1" tot "B:80").

Het aantal kolommen is statisch, het aantal rijen niet.

Iemand een idee hoe ik kan zoeken in iedere rij naar het laagste bewerkingsnummer.
Ik ben beginnende in VBA en kan alleen een drie dubbele loop (rij, kolom en bewerkingsnummer) bedenken, maar dat lijkt me totaal niet efficiënt.
Ik weet daarnaast ook niet hoe ik twee loops (rij en bewerkingsnummer) direct beëindig wanneer het gewenste resultaat is gevonden.
Als de laagste is gevonden kunnen de beide cellen gekleurd en vervolgens verder zoeken in de volgende rij.
 
Ik heb geen flauw benul wat je wilt. Ik zie een werkblad met in Kolom H alleen B:10, J met B:20; N met B:30.... en zo verder. Vergelijken in kolom H heeft dus geen enkele zin, want je vindt daar alleen B:10. En vergelijken in een rij heeft óók geen zin, want B:10 komt alleen in kolom H voor; de andere waarden zijn dan hoger. Kun je net zo goed gelijk naar kolom H verwijzen.
Zet het gewenste resultaat eens in je bestand, dan kunnen we zien wat de bedoeling is.
 
Er moet via code in iedere rij gezocht worden naar de cel met de laagste B:"waarde".

De cel met de laagste B:"waarde" dient blauw gekleurd te worden. De cel rechts van de gevonden waarde dient ook blauw gekleurd te worden.

In bijgevoegd voorbeeldbestand is het gewenste eindresultaat zichtbaar.

Iedere keer wanneer het bestand ververst wordt zullen verschillende waardes verschijnen/verdwijnen, afhankelijk van de dan geldende planning.
Daarom kan ik niet direct naar bepaalde kolommen verwijzen.
 
Code: 
Sub VenA()
Const m = 81
Dim r As Range, j As Long, ar, t As Long, jj As Long, k As Long
  With Sheets("Blad1").Cells(1).CurrentRegion
    .Cells.Interior.Color = xlNone
    ar = .Value
    For j = 3 To UBound(ar)
    t = m
      For jj = 8 To UBound(ar, 2) Step 2
        a = Split(ar(j, jj), ":")
        If UBound(a) = 1 Then
          If a(1) < t Then
            t = a(1)
            k = jj
          End If
        End If
      Next jj
      If t < m Then
        If r Is Nothing Then Set r = .Cells(j, k).Resize(, 2) Else Set r = Union(r, .Cells(j, k).Resize(, 2))
      End If
    Next j
    If Not r Is Nothing Then r.Interior.Color = vbYellow
  End With
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan