macro der fjerner dubletter i en tabel

Prøv denne:

Sub SletDubletter()

'Makro indspillet 28-11-2003 af Richardt Veje Madsen

Selection.Tables(1).Select
Selection.MoveRight Unit:=wdCell
Selection.SelectCell
   
On Error GoTo Slut
For n = 1 To 1000

    'Celle 1
    Selection.SelectCell
    svar = Selection
    Selection.MoveRight Unit:=wdCell
   
    'Celle 2
    Selection.SelectCell
    svar2 = Selection
   
    'Tjeck
    If svar = svar2 Then
        Selection.Rows.Delete
        Selection.Tables(1).Select
        Selection.MoveRight Unit:=wdCell
        Selection.SelectCell
    End If
Next
   
Exit Sub
Slut:

Exit Sub
   
End Sub

Det var tæt på i første skud.
Jeg har rettet følgende for at undgå at den starter forfra når der er hit.
rettelsen er følgende:
If svar = svar2 Then
        Selection.Rows.Delete
'        Selection.Tables(1).Select
        Selection.MoveLeft Unit:=wdCell
        Selection.SelectCell
    End If
Kan du lave det sådan at den stopper når tabellen er færdig og ikke efter 1000 loops??

Hvis den ikke behøver at starte forfra (ja - jeg lavede bare lige et skud fra hoften *S*), så kan du ændre starten til følgende:

Selection.Tables(1).Select
svar = Selection.Rows.Count
Selection.MoveRight Unit:=wdCell
Selection.SelectCell
   
On Error GoTo Slut
For n = 1 To svar

Grunden til de 1000 var at jeg tænkte du måske nogle gange havde mere end 2 ens rækker, så derfor ville jeg starte forfra hver gang, men det er selvfølgelig ikke en så pæn løsning *S*

Jeg prøver.
Jeg har lige kørt en større test og der viser sig det problem at der er forskel på om der i to ens sætninger er store bogstaver i den ene eller der er et mellemrum efter sætningen.
Jeg vil gerne at den kun sammenligner den rene tekst og ikke ser forskel på store og små bogstaver eller forskellige mellemrum.
Kan du klare den??

OK

Prøv denne:

Sub SletDubletter()

'Makro indspillet 28-11-2003 af Richardt Veje Madsen

Selection.Tables(1).Select

svar = Selection.Rows.Count

Selection.MoveRight Unit:=wdCell
Selection.SelectCell
   
On Error GoTo Slut
For n = 1 To svar

    'Celle 1
    Selection.SelectCell
    svar = Selection
    svar = Replace(svar, Chr(13), "")
    svar = Replace(svar, Chr(7), "")
    svar = UCase(svar)
   
    Selection.MoveRight Unit:=wdCell
   
    'Celle 2
    Selection.SelectCell
    svar2 = Selection
    svar2 = Replace(svar2, Chr(13), "")
    svar2 = Replace(svar2, Chr(7), "")
    svar2 = UCase(svar2)
   
    'Tjeck
    If svar = svar2 Then
        Selection.Rows.Delete
'        Selection.Tables(1).Select
        Selection.MoveLeft Unit:=wdCell
        Selection.SelectCell
    End If
Next
   
Exit Sub
Slut:

Exit Sub
   
End Sub

Det er tæt på nu, men prøv at se hvad den ikke finder:
internal team draft
internal team draft
internal team draft
internal team draft
internal team draft
Det vill være fint hvid den fandt dem som dubletter

Er det ikke netop det problme jeg nævner tidligere - altså at du her mere end 1 dublet?

Prøv denne:

Sub SletDubletter()

'Makro udarbejdet den 28-11-2003 af Richardt Veje Madsen

Selection.Tables(1).Select

svar = Selection.Rows.Count

Selection.MoveRight Unit:=wdCell
Selection.SelectCell
   
On Error GoTo Slut
For n = 1 To svar

    'Celle 1
    Selection.SelectCell
    svar = Selection
    svar = Replace(svar, Chr(13), "")
    svar = Replace(svar, Chr(7), "")
    svar = UCase(svar)
   
    Selection.MoveRight Unit:=wdCell
   
    'Celle 2
    Selection.SelectCell
    svar2 = Selection
    svar2 = Replace(svar2, Chr(13), "")
    svar2 = Replace(svar2, Chr(7), "")
    svar2 = UCase(svar2)
   
    'Tjeck
    If svar = svar2 Then
        Selection.Rows.Delete
        Do
            Selection.SelectCell
            svar2 = Selection
            svar2 = Replace(svar2, Chr(13), "")
            svar2 = Replace(svar2, Chr(7), "")
            svar2 = UCase(svar2)
            If svar = svar2 Then
                Selection.Rows.Delete
            End If
        Loop Until svar2 <> svar
    End If
Next
   
Exit Sub
Slut:

Exit Sub
   
End Sub

Så misforstod jeg dig nok. Det går fint med flere/mange dubletter. Det eksenpel jeg viste dig skulle vise at der på hver anden var et eller flere mellemrum forand sætningen og så var der ikke hit.
[blank]Internal
internal
blev ikke fanget.

OK

Så indsæt disse linier også (ved de andre raplace sætninger):

svar = Replace(svar, Chr(32), "")'fjerner mellemrum

svar2 = Replace(svar2, Chr(32), "")'fjerner mellemrum