13. september 2008 - 11:44Der er
24 kommentarer og 1 løsning
Makro - tjek C3-E3-G3-I3 osv for colerIndex=4 . Returner hvis..
I et skema fra C3:N49 har jeg følgende kriterier: C3-D3 repræsenterer henholdsvis "dag1" og "dag2" for én person. E3-F3 repræsenterer henholdsvis "dag1" og "dag2" for én anden person. Ialt er der 6 personer med hver 2 kolonner. Altså er sidste kolonne "N" og sidste række "49".
EKS på række 3. C3,D3,J3,K3,I3,M3 er røde - E3,F3,G3,H3,J3,L3,N3 er grønne. Fra og med C3 til M3 skal der nu tjekkes i HVER ANDEN celle (dag1), for GRØN farve. Findes !!4 eller flere!! celler med GRØN farve, skal der returneres med "flueben" i O3. Hvis under 4, skal cellen være blank.
Det samme skal ske for "dag2". Altså skal der tjekkes i HVER ANDEN celle, men blot fra og med D3 til N3. Retur med "flueben" i P3 hvis der findes !!4 eller flere!! celler med GRØN farve. Hvis ikke skal cellen være blank.
Dette skal lade sig gøre fra C3:N49. ----------------------------------------
Denne "Kabbak" må være brugbar når O3 er: =ColorCount((C3;E3;G3;I3;K3;M3);B51)
Og P3 er: =ColorCount((D3;F3;H3;J3;L3;N3);B51)
B51 er grøn. ----------------------------------
Function ColorCount(rRange As Range, rColor As Range) As Double Dim rCell As Range Dim dCount As Double dCount = 0 Application.Volatile For Each rCell In rRange If rCell.Interior.ColorIndex = rColor.Interior.ColorIndex Then dCount = dCount + 1 End If Next rCell ColorCount = dCount End Function
Så mangler jeg bare den modificeres til at returnerer med nævnte kriterier. :-)
Den returnerer et tal. Er tallet =4 eller over skal cellen vise "flueben". Hvis ikke skal cellen være blank.
Kan "flueben" ikke lade sig gøre, så slak "X" bruges.
Indsæt funktionen i et alm. modul returnere x Hvis det skal være flueben, så brugerformater celle til windings og i Type felt taster du ALT+0252;ALT+0252;ALT+0252;ALT+0252
Function TælColor(rng As Range, farve As Range) rk = rng.Row: fra = farve.Column For t = fra To rng.Columns.Count + (fra - 1) Step 2 If Cells(rk, t).Interior.ColorIndex = farve.Interior.ColorIndex Then tal = tal + 1 Next If tal >= 4 Then TælColor = "x" Else TælColor = "" End Function
=tælcolor(C3:N3;$C$1) ' tæller grøne celler (kontrol celle med grøn i C1) =tælcolor(C3:N3;$D$1) ' tæller røde celler (kontrol celle med rød i D1)
Du skal holde ALT tasten nede imens du taster 0252 på det numeriske tastatur, slippe ALT og taste semikolon, så igen ALT+0252 osv. resultat af denne lidt kryptiske indtastning returnerer 4 u'er med prikker over
mht. til farvekode : Klik på nr 8 i top 10 "smartoffice_dk" klik på link til hjemmesiden og søg efter Colorindex Der kan du se hvilke numre dine 2 farver har Skriv de numre ind her, så retter jeg koden til
..og dog, der var jeg sq for hurtig. Den funktion "kigger" i alle celler fra C3:N3. Det skulle kun være hveranden celle fra og med C3 for "dag1" og D3 for "dag2".
O3 =tælcolor(C3:N3;$C$1) ' dag1 P3 =tælcolor(C3:N3;$C$1) ' dag2 De er ens fordi de begge kun skal kigge efter Grøn fra kontrolcelle C1. Jeg brugerformater kolonne O og P som du beskriver og det giver flueben i alle celler.
For at få hveranden, har jeg prøvet at adskille med =TælColor((c1;E1;G1;I1;K1;M1);$C$1) Dur ikke.
ja det er vist sengetid har lige rettet koden til de farvekoder du sendte (den anden virker nu ok her)
O3=tælcolor(C3:N3;3) P3=tælcolor(C3:N3;4) kopier ned med fyldhåndtag
Function TælColor(rng As Range, farve As Integer) rk = rng.Row For t = farve To 12 + farve Step 2 If Cells(rk, t).Interior.ColorIndex = farve Then tal = tal + 1 Next If tal >= 4 Then TælColor = "x" Else TælColor = "" End Function
Hvis du foretrækker en Funktion hvor du selv indtaster cellerne kan du anvende denne =tælcolor2(C5;E5;G5;I5;K5;M5;4) tæller grønne celler Men husk funktionen kræver 6 cellereferencer og 1 farve og ikke andet
Vær i øvrigt opmærksom på at Formler såvel som Funktioner ikke trikker på Farver umiddelbart, der skal en Genberegning til som du fx kan lave med CTRL+ALT+F9
Function TælColor2(rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, rng5 As Range, rng6 As Range, farve2 As Integer)
If rng1.Interior.ColorIndex = farve2 Then tal2 = tal2 + 1 If rng2.Interior.ColorIndex = farve2 Then tal2 = tal2 + 1 If rng3.Interior.ColorIndex = farve2 Then tal2 = tal2 + 1 If rng4.Interior.ColorIndex = farve2 Then tal2 = tal2 + 1 If rng5.Interior.ColorIndex = farve2 Then tal2 = tal2 + 1 If rng6.Interior.ColorIndex = farve2 Then tal2 = tal2 + 1
Rem If tal2 >= 4 Then TælColor2 = "x" Else TælColor2 = "" TælColor2 = tal2 End Function
Jeg har nu testet de 2 "nye" funktioner. TælColor med colerindex ref virker fundstændig som den med celle ref. Altså ikke efter hensigten. Men de virker.. Tilgengæld virker den hvor jeg taster cellerne selv efter hensigten.
Problemet er at de 2 første funktioner begge starter deres sortering i D (dag2)- altså får jeg ikke C med som er "dag1".
Måske jeg ikke har forklaret mig korrekt. Mit skema er for 6 personer. De har hver 2 kolonner som hedder "Fredag for dag1" og Lørdag for dag2" Personerner kan ved hjælp af en funktion dobbeltklikke på en celle så den skifter imellem grøn og rød. Det gør de så for hver af deres kolonner som løber fra C10:M49. Det jeg så ønsker, er at se om 4 eller flere af de 6 personer har sat en grøn farve af i dag1 og/eller dag2. Resultatet skal så vises som "x" eller helst "flueben" i O10:O49 hvis 4 eller flere har sat grøn farve af i "dag1". Det samme skal ske for "dag2" men her skal det vises i P10:P49. Jeg er i princippet ligeglad med rød farve, den er kun for visualisering.
Jo men du kan jo kopiere funktionsformlen lige som andre formler Men nu da jeg har fattet hvad du vil, så skulle følgende kode virke dog skal du nu vælge 1 for dag1 eller 2 for dag2 : =tælcolor(C3:N3;1) tæller grønne på dage 1 =tælcolor(C3:N3;2) tæller grønne på dage 2
Function TælColor(rng As Range, dag As Integer) rk = rng.Row For t = 2 + dag To 12 + dag Step 2 If Cells(rk, t).Interior.ColorIndex = 4 Then tal = tal + 1 Next Rem If tal >= 4 Then TælColor = "x" Else TælColor = "" TælColor = tal End Function
Marker den eller de celler der skal være flueben i Højreklik og vælg Formater celler Klik på fanen Tal og vælg Brugerdefineret I feltet Type sletter du Standard og indtaster følgende : [ALT]0252;[ALT]0252;[ALT]0252;[ALT]0252 altså hold ALT tasten nede imens du taster 0252 på det numeriske tastatur (ikke tal under Funktionstasterne) Husk at indsætte et semikolon mellem hver u
Klik så på fanen Skrifttype og vælg Windings (3 nederst)
Ja, ved det godt - forklarer mig ikke tydeligt nok. Sorry.. Altså Det jeg tænkte var om ikke makro'en selv kunne finde de celler som TælColor har sat "X" i og så bytte x'et til et flueben...? :-)
Sub Makro1() For Each c In Sheets("Ark1").Range("A1:B20") If c = "x" Then c.NumberFormat = "ü;ü;ü;ü" With c.Font .Name = "Wingdings" .FontStyle = "Normal" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With End If Next End Sub
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
