Cells.Find

Status
Niet open voor verdere reacties.
R

ramio

Gebruiker
Lid geworden
8 okt 2008
Berichten
8
Code: 
Cells.Find(What:=ActiveCell, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=True).Activate
                                  ActiveCell.Interior.ColorIndex = 6

In de actieve cell geef ik een waarde op waarna ik wil dat er gezocht wordt naar de cellen met dezelfde waarde, en deze dus een kleurtje geeft.

Ik stuit op een probleem als het gaat om bijv. het getal 1
De cel met de waarde 10 wordt dan ook aangemerkt met een kleurtje, en dat wil ik niet.
Hoe kan ik dat voorkomen?

En tevens, hoe kan ik in een bepaald bereik laten zoeken, bijv A2: F15

Alvast bedankt,
Ramio
 
Laatst bewerkt door een moderator:
Code: 
Cells.Find(What:=ActiveCell, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
            [COLOR="#FF0000"]xlWhole[/COLOR], SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=True).Activate
                                  ActiveCell.Interior.ColorIndex = 6

Zie rood gemarkeerde..

gr,
daniel
 
Bedankt voor je snelle antwoord. Die had ik net nodig.

En weet je misschien ook hoe ik alleen in een bepaald bereik kan laten zoeken?
Ik heb het bereik A2:F15 de naam "getallen" mee gegeven.

Groet
 
Ik heb even wat gemaakt voor je, zie bijlage:
 

Bijlagen

  • vwopmmetvntactvcell.xlsm
    17,5 KB · Weergaven: 31
Dank je wel voor je hulp.
Ik heb even de tijd nodig om dit te besturen, begrijpen.
Ik laat nog horen of het me gelukt is om dit in mn eigen worksheet te hijsen.

Groet, Ramio
 
Ik denk dat je er met onderstaande instructies wel uitkomt, ik heb de code nog wat ingekort zelfs:
Code: 
Sub Kstr()
    
waarde = ActiveCell.Value


    With Range("A1:F15") 'Verander de Range("") naar dat van je eigen bestand of voeg een sheet toe zoals hieronder:
'    With Sheets("Blad1").Range("A1:F15")
    .FormatConditions.Delete
    .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:=waarde
    .FormatConditions(Range("A1:F15").FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
    .FormatConditions(1).StopIfTrue = False
    End With
End Sub
Op deze manier heb je ook dat alle cellen ineens kleuren, ipv dat je ze stuk voor stuk naloopt..

Hierbij ook het aangepast bestandje:
 

Bijlagen

  • vwopmmetvntactvcell(1).xlsm
    17,9 KB · Weergaven: 20
En dit is denk ik óók een hele goeie oplossing, dubbel klik op de cel en kleurt de gelijke waarden:
 

Bijlagen

  • vwopmmetvntactvcell(2).xlsm
    21,5 KB · Weergaven: 20
of:
Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Intersect(Target, Cells(1).CurrentRegion) Is Nothing Then
    sn = Cells(1).CurrentRegion

    For j = 1 To UBound(sn)
      For jj = 1 To UBound(sn, 2)
        If sn(j, jj) = Target.Value Then c01 = c01 & "," & Cells(j, jj).Address
      Next
    Next

    Range(Mid(c01, 2)).Interior.ColorIndex = 8
    Cancel = True
  End If
End Sub
 
Ik heb gemerkt dat mijn Excel-versie niet overweg kan met de macro-regels zoals je voorstelt. Ik maakte nog steeds gebruik van 2003. Dat vond ik wel zo handig want die gebruikte ik al jaren.
Desondanks toch maar over gestapt naar Office 2007. Heel ander uiterlijk en flink zoeken waar alles staat, maar ..... de macro doet precies wat ik wilde. Heel mooi dus !! En dat wennen duurt dan maar ff.

Dat brengt me ook weer op een nieuwe vraag:

Ik heb in rij een aantal deelnemers onder elkaar staan, met daarachter, van elk, 10 getallen.
De hierboven beschreven macro moet de gevallen Lotto balletjes hieruit vissen en geel kleuren.
Dan wil ik daarna, per deelnemer, dat de som van de gele getallen opgeteld wordt. Iets met count dus.
Bijv. in A1 staat de naam van de deelnemer, dan in B1:K1 de tien getallen, en in L1 wil ik een opsomming van de gele balletjes :)

Ik had het al voor mekaar maar ik denk dat ie vrij omslachtig is, en ik vermoed dat het veel simpeler kan.
Kortom, ik kan wel een lesje gebruiken ;-)

Greetz
 
Ik denk dat je mijn suggestie over het hoofd hebt gezien, want die loopt Excel 97, 2000, 2003, 2007 en 2010.
 
Nee hoor, ik had jouw suggestie niet over het hoofd gezien. Maar eerlijk gezegd, snap ik daar niks van. Ik ben maar een hobbyist zonder opleiding.
Ik vind het leuk om dingetjes werkbaar te krijgen, maar ik wil wel begrijpen waar ik mee bezig ben.

In ieder geval wel heel erg bedankt voor het meedenken.
 
Dat van snb is inderdaad wat gevorderder, maar daar leer ik dan weer van :thumb:
Op gegeven moment leer je dat een beetje te lezen door te experimenteren.

Intussen heb ik voor jou (Ramio) de code wat aangepast:
Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, [A:ZZ]) Is Nothing Then

    With Sheets("Blad1").Range("A1:F15")
                                        .FormatConditions.Delete
                                        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
            Formula1:=ActiveCell.Value
                                        .FormatConditions(.FormatConditions.Count).SetFirstPriority
                                   With .FormatConditions(1).Interior
                                                                .PatternColorIndex = xlAutomatic
                                                                .Color = 65535
                                                                .TintAndShade = 0
                                   End With
                                        .FormatConditions(1).StopIfTrue = False
    End With
[COLOR="#FF0000"]    With Sheets("Blad1")
                       .Range("I1").FormulaR1C1 = "=SUMIF(C1:C6," & ActiveCell.Value & ",C1:C6)"
                       .Range("I2").FormulaR1C1 = "=COUNTIF(C1:C6," & ActiveCell.Value & ")"
    End With[/COLOR]
Cancel = True
    End If
End Sub
Het rode stukje is nieuw en zorgt ervoor dat er een 'som.als'- en 'aantal.als' formule worden geplaatst in de cellen 'I1' en 'I2'.
Deze heb ik gewoon gemaakt door een macro op te nemen, de formule in te toetsen en de 'ActiveCell.Value' in plaats van de voorwaarde op te gegeven. Heel simpel dus..

Hierbij ook toegepast in het bestandje:
 

Bijlagen

  • vwopmmetvntactvcell(4).xlsm
    22 KB · Weergaven: 14
Laatst bewerkt:
Oh ik zag dat ie nog fout liep als je een lege cel pakte..

Heb ik verholpen:
Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, [A:ZZ]) Is Nothing Then
    With Sheets("Blad1")
                        .Range("H1:I2").ClearContents
                        .Range("A1:F50").FormatConditions.Delete
    If Target = "" Then Exit Sub
                   With .Range("A1:F50")
                                        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
                                         Formula1:=ActiveCell.Value
                                        .FormatConditions(.FormatConditions.Count).SetFirstPriority
                                   With .FormatConditions(1).Interior
                                                                .PatternColorIndex = xlAutomatic
                                                                .Color = 65535
                                                                .TintAndShade = 0
                                   End With
                                        .FormatConditions(1).StopIfTrue = False
                   End With
                   With Sheets("Blad1")
                                       .Range("H1").Value = "Som :"
                                       .Range("H2").Value = "Aantal :"
                                       .Range("I1").FormulaR1C1 = "=SUMIF(C1:C6," & ActiveCell.Value & ",C1:C6)"
                                       .Range("I2").FormulaR1C1 = "=COUNTIF(C1:C6," & ActiveCell.Value & ")"
                   End With
    End With
Cancel = True
End If
End Sub

en:
 

Bijlagen

  • vwopmmetvntactvcell(5).xlsm
    21,6 KB · Weergaven: 18
Ik moet m'n hoofdbreker toch weer even bijstellen. :)
Wat ik namelijk wil, is dat de gele vakjes in een rij worden opgeteld, zonder ze te vergelijken met een andere waarde.
In Office 2003 had ik het op de onderstaande wijze geformuleerd, waarbij het me nu, in Office 2007 niet lukt om de rode regel juist te krijgen.

Code: 
Sub Gele_cellen_tellen()       
    
    Range("N3").Select

1   ActiveCell.Offset(1, -11).Range("a1").Select
        If ActiveCell.Value = "" Then
        Range("T13").Select
        Exit Sub
        End If 
       
    Do
        ActiveCell.Offset(0, 1).Range("a1").Select
        
             If ActiveCell.Column = 14 Then
             ActiveCell.Value = Range("P2").Value
                 If ActiveCell.Value = "" Then ActiveCell.Value = 0
                 Range("P2").ClearContents
                 GoTo 1
             End If
        
        [COLOR="#FF0000"]If ActiveCell.Interior.Color = 65535[/COLOR] Then
        Range("P2").Value = Range("P2").Value + 1
        End If
    Loop       
    
End Sub


Om het een en ander misschien wat duidelijker te maken stuur ik de sheet mee.

Groet, Ramio
 

Bijlagen

  • Getallenspel.xlsm
    38,6 KB · Weergaven: 19
Laatst bewerkt door een moderator:
@Ramio Die regel is tegenwoordig in elk geval zo:
Code: 
If ActiveCell.Interior.Color[COLOR="#FF0000"]Index[/COLOR] = 65535 Then
Voor de rest is het maar een chaotisch bestand vind ik, het merendeel kan je denk ik beter zonder vba doen..
 
Laatst bewerkt:
Vertel mij eens wat er aan jouw code eenvoudiger is dan aan mijn suggestie ??
 
@Ramio

Bij deze heb ik je bestand helemaal zonder vba gemaakt, volgens mij veel beter in gebruik dan wat jij hebt:
 

Bijlagen

  • Getallenspel zondervba(kstr).xlsx
    22,2 KB · Weergaven: 29
Ik wil jullie hartelijk danken voor jullie inbreng.
En ja, dat van mij ziet er ongetwijfeld chaotisch uit, maar zoals ik al zei ben ik maar een hobbyist :)
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan