Excel - Data validering formel

Utgave

Jeg har et spredt ark som sporer oppmøte. Det jeg vil gjøre er å varsle brukeren når 3 eller flere celler i sekvensen inneholder de samme dataene . f.eks. Hvis noen ringer i syk, er en S plassert i cellen, hvis denne personen er syk mandag, tirsdag, onsdag, jeg vil varsle brukeren. (3 dager i sekvens med de samme dataene). Hvis personen er syk på Thur så vel, vil jeg varsle brukeren igjen.

Løsning

• 1. Trykk ALT + F11 for å åpne VBE
• 2. Trykk CTRL + R for å åpne Project Explorer
• 3. Dobbeltklikk på arket der du vil ha denne meldingsboksen
• 4. Lim inn koden

 Private Sub Worksheet_Change (ByVal Mål som Range) Dim vPos Som Variant Dim ICol Som Integer Dim CellValue Som Variant Hvis ((Target.Columns.Count = 1) Og (Target.Rows.Count = 1)) Så hvis Target = "" Så Exit Sub End Hvis vPos = "" Application.EnableEvents = False For Hver Celle I Mål Hvis UCase (Cell) "S" Så Go To Next_Cell vPos = "" iCol = Cell.Column Hvis iCol> = 3 Så Hvis ((Cell = Cell .Offset (0, -2)) Og (Cell.Offset (0, -1) = Cell)) Så vPos = -1 Slutt hvis slutt hvis If ((vPos = "") Og (iCol> = 2) Og iCol <Columns.Count)) Så Hvis ((Cell = Cell.Offset (0, -1)) Og (Cell.Offset (0, 1) = Cell)) Så vPos = 0 Slutt hvis slutt hvis If ((vPos = "") Og (iCol <Columns.Count - 1)) Så Hvis ((Cell = Cell.Offset (0, 1)) Og (Cell.Offset (0, 2) = Cell)) Så vPos = 1 Slutt hvis End Hvis If (vPos "") Så Gå til End_Sub End hvis Next_Cell: Next End_Sub: Application.EnableEvents = True If (vPos "") Så MsgBox "Tre på rad" Slutt hvis End Sub 

Hvis du varsler om å være aktivert bare for hverdager (mandag til fredag).

 Private Sub Worksheet_Change (ByVal Target As Range) Dim VPos Som Variant Dim ICol Som Integer Dim CellValue Som Variant Dim IOffsetL2 Som Integer Dim IOffsetL1 Som Integer Dim IOffsetR1 Som Integer Dim IOffset2 Som Integer Dim CellL2 Som Variant Dim CellL1 Som Variant Dim Cell0 Som Variant Dim CellR1 Som Variant Dim CellR2 Som Variant Hvis ((Target.Columns.Count = 1) Og (Target.Rows.Count = 1)) Så hvis Target = "" Avslutt deretter Sub End Hvis vPos = "" 'Avslutt Sub On Error GoTo End_Sub Application.EnableEvents = False for hver celle i Target Cell0 = UCase (Cell.Value) 'Hvis Cell0' S 'Then GoTo Next_Cell vPos = "" iOffsetL2 = 0 iOffsetL1 = 0 iOffsetR1 = 0 iOffsetR2 = 0 iCol = Cell.Column If CellD2 = "Garbage Value" CellL1 = "Garbage Value" CellR1 = "Garbage Value" CellR2 = "Garbage Value" Velg sak (Ukedag (Cells (1, iCol), vbMonday) ) Case er = 1 iOffsetL2 = -2 iOffsetL1 = -2 iOffsetR1 = 0 iOffsetR2 = 0 Case er = 2 iOffsetL2 = -2 iOffsetL1 = 0 iOffsetR1 = 0 iOffsetR2 = 0 sak er = 4 iOffsetL2 = 0 iOffsetL1 = 0 iOffsetR1 = 0 iOffsetR2 = 2 Case er = 5 iOffsetL2 = 0 iOffsetL1 = 0 iOffsetR1 = 2 iOffsetR2 = 2 End Velg End hvis feilen fortsetter neste CellL2 = Cell.Offset (0, (-2 + iOffsetL2 Verdi CellL1 = Cell.Offset (0, (-1 + iOffsetL1)). Verdi CellR1 = Cell.Offset (0, (1 + iOffsetR1)). Verdi CellR2 = Cell.Offset (0, (2 + iOffsetR2) ) .Value på feil GoTo End_Sub CellL2 = UCase (CellL2) CellL1 = UCase (CellL1) CellR1 = UCase (CellR1) CellR2 = UCase (CellR2) Hvis (iCol + iOffsetL2> 2) Then '? ? X Hvis ((CellL2 = Cell0) Og (CellL1 = Cell0)) Så vPos = -1 Gå Til End_Sub End Hvis End Hvis If ((iCol + iOffsetL1> 0) Og ((iCol - iOffsetR1) <Columns.Count)) Så ' ? X? Hvis ((CellL1 = Cell0) Og (Cell0 = CellR1)) Så vPos = 0 Gå Til End_Sub End Hvis End Hvis If (iCol <Columns.Count - 1) Then 'X? ? Hvis ((Cell0 = CellR1) Og (Cell0 = CellR2)) Så vPos = 1 Gå til End_Sub End hvis slutt hvis Next_Cell: Next End_Sub: Application.EnableEvents = True If (vPos "") Så MsgBox "Tre på rad" Slutt Sub 

Takk til rizvisa1 for dette tipset.