Inputbox für Duplikate löschen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Bin jetzt auf eine andere Lösung gestoßen.
Damit funktioniert die Spaltenauswahl per Inputbox.

Sub DuplikateLöschen_SpalteX()
'Löscht alle Duplikate in Spalte X, und gesamte Zeile mit Duplikaten

Dim Spalte As String
Dim S As Integer
Dim i As Integer, j As Integer

Application.ScreenUpdating = False
Spalte = UCase(InputBox("Bitte geben Sie die Spalte ein!", "Eingabe", "A"))
If Spalte = "" Then Exit Sub
S = Asc(Spalte) - 64

'Makro arbeitet von unten nach oben!
For i = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
For j = 2 To ActiveSheet.Cells(Rows.Count, S).End(xlUp).Row
If Cells(i, S) = Cells(j, S) And i <> j Then
Rows(i).Delete
GoTo Weiter
End If
Next j
Weiter:
Next i

Application.ScreenUpdating = True
End Sub

Wäre aber schon gut wenn zu dem ersten Makro auch noch eine Lösung gefunden würde.

Gruß
Franz

Hallo Franz,

hier der code wie er bei mir funktioniert, von A über AA bis IV.
Es sind einige Kommentare usw drin, siehe das letzte mail.

Sub DuplikateLöschen_Spalten()
'Löscht alle Duplikate in Spalte , und gesamte Zeile mit Duplikaten
'programmiert von ?
'bearbeitet von A.Schau am 08.10.2002
    Dim LastC As Long, x As Long
'String-Variable für range
    Dim Spalte$
'Ganzzahl-Variable für cells
    Dim S%, Sl%, Sr%
'Auf Null setzen für Plausibilitätsprüfung Buchstabe bei zweistelligem String
    Sl = 0: Sr = 0
'Flackern aus
    Application.ScreenUpdating = False
'...
    Spalte = InputBox("Bitte geben Sie die Spalte ein!", "Eingabe")
'wenn leer oder mehr als 2 Zeichen dann beenden
'alternativ auch Msgbox und Rücksprung zur Inputbox mit Sprungmarke möglich
    If Spalte = "" Or Len(Spalte) > 2 Then Exit Sub
'Eingabe mit zwei Zeichen umrechnen
    If Len(Spalte) = 2 Then
        Sl = (Asc(UCase(Left(Spalte, 1))) - 64) * 26  'bei AA sollte hier 1*26 = 26 rauskommen
        Sr = Asc(UCase(Right(Spalte, 1))) - 64 'und hier bei AA dann 1
        S = Sl + Sr 'und hier bei AA 27
    Else
'Eingabe mit einem Zeichen umrechnen
        S = Asc(UCase(Spalte)) - 64
    End If
'Plausibilitätsprüfung, eventuell werden nicht alle Fehler abgefangen?
'
    If S < 1 Or S > 256 Or Sl < 0 Or Sr < 0 Then Exit Sub
'letzte Zelle der Spalte ermitteln
    LastC = Range(Spalte & "65536").End(xlUp).Row
'Schleife von letzter Zelle bis Zelle1 auslichten, es werden immer
'die letzten vorkommenden "multikate" entfernt
    For x = LastC To 1 Step -1
        If WorksheetFunction.CountIf(Range(Spalte & "1:" & Spalte & x), Cells(x, S)) > 1 Then
            Cells(x, S).EntireRow.Delete
        End If
    Next
'Flackern ein
    Application.ScreenUpdating = True
End Sub

Code eingefügt mit Syntaxhighlighter 1.16

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Inputbox für Duplikate löschen

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread