13. marts 2005 - 17:12Der er
25 kommentarer og 1 løsning
betinget formatering - celle minus en
Har lavet et ekspempe hvor jeg har lavet 3 felter med betinget formatering gregorian.dk/eksempel.xls
det mit spørgsmål lyder på er: hvordan laver jeg et script der siger HVIS feltet til venstre for er STØRRE end det nuværende SÅ baggrund = rød
HVIS feltet til venstre for er MINDRE end det nuværende SÅ baggrund = GRØN
HVIS feltet til venstre for er LIG end det nuværende SÅ baggrund = GUL
HVIS feltet til venstre for er ikke findes eller fejl SÅ baggrund = GUL
det er det jeg har gjort med betinget formatering på et enkelt felt, men hvordan gøres det så jeg ikke skal gøre det ved hvert eneste felt jeg opretter?
For skal bruge denne formatering på hundredevis af felter som har disse betingelser?
jKrons.. den metode som du har beskrevet ovenover gør jo at jeg skal formatere ALLE felterne og jeg har jo flere hundrede.. kan man ikke lave en form for macre til dette formål?
Public Sub SkiftFarve() For Each c In Selection F = Selection.Columns.Count - 1 A = Selection.Columns(Selection.Columns.Count).Column - F If c.Column <> A Then If c.Offset(0, -1).Value > c.Value Then c.Interior.Color = vbGreen If c.Offset(0, -1).Value = c.Value Then c.Interior.Color = vbYellow If c.Offset(0, -1).Value < c.Value Then c.Interior.Color = vbRed Else c.Interior.Color = vbYellow End If Next
denne virker på 1 kolonne lodret og på mange vandret
Public Sub SkiftFarve() Range("B2:K4".select , hvis du retter i denne linie til dit område, skal du ikke markere f = Selection.Columns.Count - 1 For Each C In Selection If f > 0 Then A = Selection.Columns(Selection.Columns.Count).Column - f If C.Column <> A And C <> "" And C.Offset(0, -1) <> "" Then If C.Offset(0, -1).Value > C.Value Then C.Interior.Color = vbGreen If C.Offset(0, -1).Value = C.Value Then C.Interior.Color = vbYellow If C.Offset(0, -1).Value < C.Value Then C.Interior.Color = vbRed Else C.Interior.Color = vbYellow End If Else R = Selection.Rows.Count - 1 B = Selection.Rows(Selection.Rows.Count).Row - R If C.Row <> B And C <> "" And C.Offset(-1, 0) <> "" Then If C.Offset(-1, 0).Value > C.Value Then C.Interior.Color = vbGreen If C.Offset(-1, 0).Value = C.Value Then C.Interior.Color = vbYellow If C.Offset(-1, 0).Value < C.Value Then C.Interior.Color = vbRed Else C.Interior.Color = vbYellow End If End If Next End Sub
x2 skal sammeligne om den er større, mindre eller lig x1 x3 skal sammeligne om den er større, mindre eller lig x2 x4 skal sammeligne om den er større, mindre eller lig x3
y2 skal sammeligne om den er større, mindre eller lig y1 y3 skal sammeligne om den er større, mindre eller lig y2 y4 skal sammeligne om den er større, mindre eller lig y3
z2 skal sammeligne om den er større, mindre eller lig z1 z3 skal sammeligne om den er større, mindre eller lig z2 z4 skal sammeligne om den er større, mindre eller lig z3
x1, y1, z1 skal ikke sammenligne med nogen da der ikke er et felt ovenover.
den skal sammenligne forrige resultat med det nuværende.
Sæt denne kode derind, den kører når du skifter fra og til arket
Private Sub Worksheet_Activate() Dim K As Integer, RW As Long, C As Range Col = Array("X", "Y", "Z") ' de kolonner der skal tjekkes SRW = 1 ' startrække SLRW = 4 ' Slutrække For K = 0 To UBound(Col) For RW = SRW To SLRW Set C = Cells(RW, Col(K)) If RW <> SRW Then If C.Offset(-1, 0) <> "" Then If C.Offset(-1, 0).Value > C.Value Then C.Interior.Color = vbGreen If C.Offset(-1, 0).Value = C.Value Then C.Interior.Color = vbYellow If C.Offset(-1, 0).Value < C.Value Then C.Interior.Color = vbRed Else C.Interior.Color = vbYellow End If Else C.Interior.Color = vbYellow End If Next Next Set C = Nothing End Sub
en lille rettelse Private Sub Worksheet_Activate() Dim K As Integer, RW As Long, C As Range Col = Array("X", "Y", "Z") ' de kolonner der skal tjekkes SRW = 1 ' startrække SLRW = 10 ' Slutrække For K = 0 To UBound(Col) For RW = SRW To SLRW Set C = Cells(RW, Col(K)) If RW <> SRW Then If C.Offset(-1, 0) <> "" And C <> "" Then If C.Offset(-1, 0).Value > C.Value Then C.Interior.Color = vbGreen If C.Offset(-1, 0).Value = C.Value Then C.Interior.Color = vbYellow If C.Offset(-1, 0).Value < C.Value Then C.Interior.Color = vbRed Else C.Interior.Color = vbYellow End If Else C.Interior.Color = vbYellow End If Next Next Set C = Nothing End Sub
har en ting som jeg godt lige vil have implenteret deri.. hvis feltet som den sammenligner fra er tomt så skal den bare være "ingen farve" altså
x1 y1 z1 x2 y2 z2 x3 y3 z3 x4 y4 z4
hvis x3 y3 z3 x4 y4 z4 er tomme skal de ikke farvelægges som gul. gul er KUN til hvis den er den samme værdi som den ovenstående. der skal altså bare laves et tjek på at den kun skal gøre det hvis der står en talværdi i feltet
her er en den skal erstatte den anden, den vorker når arket beregnes.
Private Sub Worksheet_Calculate() Dim K As Integer, RW As Long, C As Range Col = Array("X", "Y", "Z") ' de kolonner der skal tjekkes SRW = 1 ' startrække SLRW = 10 ' Slutrække For K = 0 To UBound(Col) For RW = SRW To SLRW Set C = Cells(RW, Col(K)) If RW <> SRW Then If C.Offset(-1, 0) <> "" And C <> "" Then If IsNumeric(C.Offset(-1, 0)) And IsNumeric(C) Then If C.Offset(-1, 0).Value > C.Value Then C.Interior.Color = vbGreen If C.Offset(-1, 0).Value = C.Value Then C.Interior.Color = vbYellow If C.Offset(-1, 0).Value < C.Value Then C.Interior.Color = vbRed Else If IsNumeric(C) Then C.Interior.Color = vbYellow Else C.Interior.ColorIndex = xlNone End If End If Else If IsNumeric(C) And C <> "" Then C.Interior.Color = vbYellow Else C.Interior.ColorIndex = xlNone End If End If Else C.Interior.Color = vbYellow End If Next Next Set C = Nothing
jeg takker mange gange for jeres ekspertise .. til kabbak: tak for hjælpen til udforming af macroen til bak: mange tak for det rigtige gode eksempel på betinget formatering. det som jeg syntes var brugbart var af få af vide hvad jeg skulle skrive i formel feltet. og et spørgsmål til det. hvad betyder OG ?
tja. i har begge løst mit problem, men dog mest kabbak. Bak håber det er fair nok at jeg giver kabbak pointene.
Jeg fandt en fejl i eksemplet som nu er rettet. Det er helt iorden at give kabbak pointene, da han jo har løst opgaven på den måde du ønskede :-)
=OG( B3 < B2; B2 <> "") betyder at der er to betingelser der skal være opfyldt begge to før end at der skal farves fx grøn. Nemlig at cellen skal være mindre end den ovenstående og at den ovenstående ikke må være blank
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.
