27. maj 2004 - 23:25Der er
12 kommentarer og 1 løsning
macro til sammenligning af naboceller
Jeg skal bruge en macro som kan gennemløbe et antal rækker og for hver række sammenligne hver celle med nabocellen. Hvis indholdet i en celle er "ugyldig" skal det markeres ved at cellen blinker. Efter et gennemløb af rækkerne kan der altså være mere end en celle som står og blinker!
Forestil Jer en vagtplan hvor en person typisk har forskellige vagttyper hen over en periode på eks. tre måneder. Hver celle i en række dækker et enkelt døgn og kan kun indeholde et enkelt bogstav som beskriver en "vagttype": D=dagvagt, A=aftenvagt, N=nattevagt, F=Fri osv.
En person kunne eks. have én uge som ser sådan ud: Man, Tir, Ons, Tor, Fre, Lør, Søn D D A A A F F
Et kriterie er, at man ikke må have en dagvagt umiddelbart efter en nattevagt (noget med overenskomster), og det er de situationer jeg vil fange. Eksemplet herunder vil blinke i cellerne under Tirsdag og Torsdag:
Sub FarvFelter() Range("B2").Select ' Øverste venstre celle i området Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToRight)).Select For Each C In Selection.Cells If C = "N" And C.Offset(0, 1) = "D" Then C.Offset(0, 1).Select With Selection.Interior .ColorIndex = 3 .Pattern = xlSolid End With Else C.Offset(0, 1).Select Selection.Interior.ColorIndex = xlNone End If Next End Sub
Det er ikke usandynligt at jeg bliver det. Og jeg havde slet ikke overvejet at fange de ugyldige værdier 'on the fly'.
Men jeg har i mellemtiden overvejet en anden løsning:
I stedet for de blinkende celler så vil jeg udvide din macro betydeligt, sådan at den genererer en dialogboks med en liste over de celler som har ugyldige værdier. Jeg nævnte kun et kriterie tidligere, men der er mange flere; eksempelvis at der maks. må være 12 døgn mellem to fridage, eller at man kun to gange på en uge må have et "vagtskifte" hvor der kun er 8 fritimer imellem (eks fra A->D => at man har fri kl. 24 og skal møde kl. 7)
Fandt en løsning som jeg kan acceptere og som fanger de ugyldige værdier 'on the fly':
Her er min makro (worksheet) som nu både håndterer farver og blink ;-)
Option Explicit Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo finito If Not Intersect(Target, Range("K16:AZ66")) Is Nothing Then Target.Font.ColorIndex = 0 'Sort Select Case Target.Value
Case Else Target.Interior.ColorIndex = 19 End Select End If
Blinking: For Each C In Target.Cells If C = "N" And C.Offset(0, 1) = "D" Then C.Offset(0, 1).Select For i = 1 To 10 ' set one color With Target.Interior .ColorIndex = 2 .Pattern = xlSolid Call Sleep(100) End With
' set another color With Target.Interior .ColorIndex = 1 .Pattern = xlSolid Call Sleep(100) End With Next i End If Next C End Sub
Blinking: If Target = "N" And Target.Offset(0, 1) = "D" Or _ Target = "D" And Target.Offset(0, -1) = "N" Then ' Tjekker til begge sider (god hvis du retter) For i = 1 To 10 ' set one color With Target.Interior .ColorIndex = 2 .Pattern = xlSolid Call Sleep(100) End With
' set another color With Target.Interior .ColorIndex = 1 .Pattern = xlSolid Call Sleep(100) End With Next i Target.Select End If
et forslag, men din er ellers god
Synes godt om
Ny brugerNybegynder
Din løsning...
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.
