Rem Version 1 - 06.10.2016 Rem ====================== Dim antalRækker As Long, iD As String, FraDato As Date, tilDato As Date Dim ræk As Long Sub kontrolAfDubletter() antalRækker = Cells(Rows.Count, "A").End(xlUp).Row Application.ScreenUpdating = False
For ræk = 2 To antalRækker - 1 iD = Right(Range("P" & ræk), 6) FraDato = Range("Q" & ræk) tilDato = Range("R" & ræk)
check ræk, iD, FraDato, tilDato Next ræk End Sub Private Sub check(aRæk, aId, aFra, atil) Dim r As Long For r = aRæk + 1 To antalRækker If Right(Range("P" & r), 6) = aId Then If aFra < Range("Q" & r) And atil < Range("R" & r) Or _ atil > Range("Q" & r) And atil > Range("R" & r) Then Else Range("A" & r & ":R" & r).Select Selection.Font.Bold = True End If
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.