• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Gegevens ordenen aan de hand van de tekstkleur

Status
Niet open voor verdere reacties.

ladylite

Nieuwe gebruiker
Lid geworden
4 aug 2016
Berichten
3
Tabblad 1
In kolom A staan 12 namen.
In kolom B staan cijfers van 1 tot 6 in het groen én cijfers van 1 tot 6 in het rood, dit in willekeurige volgorde.

Tabblad 2
In kolom A staan eerst de groene cijfers van 1 tot 6 en daarna de rode van 1 tot 6.
Ik ben op zoek naar een formule die in kolom B de juiste namen naast het bijhorende cijfer kan zetten.

Heeft iemand een idee hoe ik dit geregeld krijg? Ik heb echt al vanalles geprobeerd...
Dankjewel! :)
 
Ik heb al één iets (uw eerste vraag), de rest zoek ik morgen wel verder uit.
 

Bijlagen

Ik dacht meer aan zoiets.
Code:
Sub hsv()
Dim tmp, arr, cl As Range, j As Long, x As Long, i As Long, jj As Long
For j = 2 To 3
ReDim arr(1, 0)
For Each cl In Sheets("gegevens").Columns(2).SpecialCells(2)
 If cl.Font.ColorIndex = j + IIf(j = 2, 12, 0) Then
  ReDim Preserve arr(1, UBound(arr, 2) + 1)
     arr(0, x) = cl.Value
     arr(1, x) = cl.Offset(, -1)
     x = x + 1
  End If
  Next cl
  For i = 0 To UBound(arr, 2) - 1
    For jj = i + 1 To UBound(arr, 2) - 1
       If CLng(arr(0, i)) >= CLng(arr(0, jj)) Then
            tmp = arr(0, jj) & "|" & arr(1, jj) & "|"
            arr(1, jj) = arr(1, i)
            arr(0, jj) = arr(0, i)
            arr(1, i) = Split(tmp, "|")(1)
            arr(0, i) = Split(tmp, "|")(0)
        End If
    Next jj
   Next i
  With Sheets("resultaat").Cells(Rows.Count, 1).End(xlUp).Offset(1)
    .Resize(UBound(arr, 2), 2).Value = Application.Transpose(arr)
    .Resize(UBound(arr, 2)).Font.ColorIndex = j + IIf(j = 2, 12, 0)
    .Offset(, 1).Resize(UBound(arr, 2)).Font.ColorIndex = -4105
  End With
  Erase arr
  x = 0
  Next j
End Sub

Of andere methode:

Met in a1:b1 koptekst.
Code:
Sub hsv()
Dim sn
With Sheets("gegevens").Cells(1).CurrentRegion
sn = Sheets("gegevens").Cells(1).CurrentRegion
     .AutoFilter 2, RGB(0, 176, 80), xlFilterFontColor
     .Parent.AutoFilter.Range.Offset(1).Sort [b1]
     .Offset(1).Copy Sheets("resultaat").Cells(1, 1)
     .Parent.AutoFilter.Sort.SortFields.Clear
     .AutoFilter 2, RGB(255, 0, 0), xlFilterFontColor
     .Parent.AutoFilter.Range.Offset(1).Sort [b1]
     .Offset(1).Copy Sheets("resultaat").Cells(Rows.Count, 1).End(xlUp).Offset(1)
     .AutoFilter
     .Parent.Cells(1).Resize(UBound(sn), 2) = sn
End With
With Sheets("resultaat")
     .Columns(1).Insert
     .Columns(3).SpecialCells(2).Copy .Cells(1)
     .Columns(3).Clear
    End With
End Sub
 

Bijlagen

Laatst bewerkt:
Ja, dit werkt precies wel hé! Dankjewel alvast.
Alleen... ik ben geen pro. Dus waar geef ik dit precies in? En ik ga de codes ook moeten aanpassen aan mijn document, wat iets ingewikkelder is dan het voorbeeld dat ik gaf. Dat zoek ik wel uit dan.
Ik had gehoopt dat het met een formule opgelost zou zijn, maar het blijkt toch iets ingewikkelder te zijn dan ik dacht ;)
 
Met formules op kleuren sorteren of zoeken op kleur gaat niet.
Alleen de filter kan werken met kleuren.

Plaats anders het bestand zoals het er in wekelijkheid uit ziet met fictieve gegevens; misschien is dat ook wel weer op te lossen (ik kan niets beloven).
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan