fjerne dupletter

Kan du ikke lige paste makroen så vi kan se den

ups jeg refererede til det forkerte spørgsmål
www.eksperten.dk/spm/56118
Det går fint med at markere dubletter med fed skrift. Men denne kan jeg ikke få til at virke
Sub SletDubletter()
Dim iX As Integer
Dim iRow As Integer
Dim rCell As Range

    For Each rCell In Range(\"B1:B20\")
        If rCell = \"\" And rCell.Offset(1, 0) = \"\" And rCell.Offset(2, 0) = \"\" Then
            iRow = rCell.Row
            Exit For
        End If
    Next rCell
   
    For iX = iRow To 2 Step -1
        If Range(\"B\" & iX).Font.Bold = True Then Range(\"B\" & iX).EntireRow.Delete
    Next iX

End Sub

og denne går ned når der er mange poster:

Sub FjernDublettal()

  Dim dubletter    As Range
  Dim celle1      As Range
  Dim Celle2      As Range
    For Each celle1 In Selection

        For Each Celle2 In Selection

            If celle1 = Celle2 Then

                If celle1.Address <> Celle2.Address Then

                    If dubletter Is Nothing Then
                      Set dubletter = Union(celle1, Celle2)
                    Else
                      Set dubletter = Union(dubletter, celle1, Celle2)
                    End If

                End If

            End If

        Next Celle2

    Next celle1
    dubletter.Clear
    Selection.Sort ActiveCell, xlAscending
  \'Eller:
  \'dubletter.Delete (xlShiftUp)
   
End Sub
hook

Skal du have linierne slettet eller ønsker du bare en liste uden dubletter ?

Hvis du bare ønsker en ny liste uden dubletter så test lige den her makro
Sub remdups()
Dim AllCells As Range, Cell As Range
Dim item
Dim y As Long
    Dim NoDupes As New Collection
    Set AllCells = Selection
        On Error Resume Next
    For Each Cell In AllCells
        NoDupes.Add Cell.Value, CStr(Cell.Value)
    Next Cell
    On Error GoTo 0
    Selection.ClearContents
    For Each item In NoDupes
        y = y + 1
        Selection.Cells(y, 1) = item
    Next
End Sub

Du skal lige markere hele listen før du starter makroen

Den virker fint
problemet er bare at den trækker listen sammen.
Jeg ville gerne have at dupletterne efterlod tomme celler.
hook

så skal vi bare ha' koblet lidt mere på.


Sub RemoveDuplicates()
Application.ScreenUpdating = False
    Dim AllCells As Range, Cell As Range
    Dim NoDupes As New Collection
    Set AllCells = Selection
        On Error Resume Next
    For Each Cell In AllCells
        NoDupes.Add Cell.Value, CStr(Cell.Value)
    Next Cell
    On Error GoTo 0
    For Each Cell In Selection
        If SearchCollection(NoDupes, Cell.Value) = True Then
            NoDupes.Remove CStr(Cell.Value)
        Else
            Cell.Value = ""
    End If
Next
End Sub

Function SearchCollection(colSearch As Collection, _
                          strKey As String) As Boolean
    Dim varItem As Variant
    Dim strTemp As String
   
    On Error Resume Next
    varItem = CVar(colSearch.item(strKey))
    If Err.Number <> 0 Then
        If Err.Number = 5 Then
            SearchCollection = False
        Else
            If Err.Number = 438 Then
                Err.Clear
                Set varItem = CVar(colSearch.item(strKey))
                If Err.Number <> 0 Then
                    SearchCollection = False
                Else
                    SearchCollection = True
                End If
            End If
        End If
    Else
        SearchCollection = True
    End If
End Function

det virker fint
hvad er det for en funktion du har tilføjet til sidst og hvordan kaldes den
hook

Der er bare en funktion der checker om cellens værdi findes i listen over unikke værdier. Den bliver kaldt af af den øverste sub.

Der findes faktisk en "manuel" løsning:
Det antages at data står i kolonne C (indsæt evt, tomme kolonner)
Der skal sltså bruges to tomme kolonner:
a) Den ene udfyldes med linienummer (1,2,3,...)
b) Sortér det hele efter data (Dupletter står efter hinanden)
c) I den anden kolonne udfyldes med formlen =HVIS(C3=C2;"";C3), checker om den ovenover er magen til.
d) Kopier hele den anden kolonne og indsæt som værdier
e) Sortér derefter det hele efter første kolonne igen (for at genskabe den originale sortering
f) Slet derefter de oveflødige kolonner

Ingen makroer, og det går faktisk rimeligt hurtigt. Om man bedst kan lide en ene eller anden løsning afhænger naturligvis af, hvor ofte man skal bruge funktionen.

softcare> prøv at formlen i http://www.eksperten.dk/spm/246488
Her slipper du for sorteringen

til bak
tak det kan jeg se nu. nærlæsningsproblem ;)
til softcareconsult
Jeg vil helst køre makroer da andre også skal kunne benytte funktionen uden at skulle sætte sig ind i for meget.

tak for hjælpen
hook