Cellen controleren en ergens anders plaatsen.

[Royzilla]

Hee goedemorgen, gister ben ik goed geholpen maar ik wil nog zelf in dit kleine opdrachtje iets toevoegen waar ik eerlijk gezegt niet mee uitkom.

Het gene wat ik probeer is: Kolom A heeft 20 namen. Kolom B heeft 20 cijfers. Ik wil aan de hand van Kolom B zien wie een score heeft behaald onder de 50. Nou onder de 50 wordt in rood aangegeven. Dan zou het toch ook gewoon mogelijk kunnen zijn op een manier om de namen die bij die onvoldoende horen in bijvoorbeeld Kolom D onder elkaar te plaatsen? Iemand een idee om me een zetje in de rug te geven?

Private Sub CommandButton1_Click()

    Dim n As Integer
    Dim i, teller As Integer
    Dim voldoende, onvoldoende As Long
    Dim onvoldoendeScore, voldoendeScore As Range
    
    onvoldoende = Range("B1:B20").Value < 50
    voldoende = Range("B1:B20") > 50
    
    Set voldoendeScore = Range("B1:B20").Find(What:=voldoende)
    Set onvoldoendeScore = Range("B1:B20").Find(What:=onvoldoende)
    
    Range("....").Value = BottomScorer.Offset(....).Value
    Range("....").Value = TopScorer.Offset(....).Value
    
        For i = 1 To 20
         'For n = 1 To 20
            If CELLS(i, 2).Value > 50 Then
                teller = teller + 1
                CELLS(i, 2).Font.ColorIndex = 5
            Else
                CELLS(i, 2).Font.ColorIndex = 3
                
           ' ElseIf CELLS(i, 2).Value < 50 Then
           '     CELLS(n, 1).Font.ColorIndex = 3
           '     Else
           '     teller = teller + 1
           '     CELLS(n, 1).Font.ColorIndex = 5
            End If
        'Next n
        Next i
        
    With CELLS(20, 1).Resize(, 2).Borders(xlEdgeBottom)
           .Weight = 2
           .LineStyle = xlContinuous
    End With
        
    CELLS(21, 2).Value = teller
    CELLS(21, 2).Font.Bold = True
    CELLS(22, 2).Value = 20 - teller
    CELLS(22, 2).Font.Bold = True

End Sub

Het moet wel zo zijn dat ik er wat van leer en dat het niet allemaal voorgekauwt wordt !

Ik weet dat de code op dit moment niet werkt maar dat komt omdat ik het opstuur zoals ik het nu heb.

Alvast bedankt!

 

[Tha Devil]

Verplaatst van Visual Basic naar Visual Basic for Applications

 

[Niels28]

Niet alles voorgekauwd,

Filter op <=50
kopieer resultaat naar kolom B
zet filter weer terug.

De rest nog niet lezen dan

Sub filter()

    ActiveSheet.Range("$A$1:$B$20").AutoFilter Field:=2, Criteria1:="<=50", _
        Operator:=xlAnd
    Range("A1:B20").Copy Range("D1")
    ActiveSheet.Range("$A$1:$B$20").AutoFilter
   
End Sub

Niels

 

[Royzilla]

Thanks! Hier kan ik mee verder mijn vraag is opgelost ^^!

Ontzettend bedankt !