Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Doppelte Einträge löschen | Herbers Excel-Forum


Betrifft: Doppelte Einträge löschen von: André Zschech
Geschrieben am: 07.01.2012 12:48:22

Schönen guten Tag!
Ich habe in meiner Literatur folgendes Makro gefunden und möchte damit auf einem Tabellenblatt "D" doppelte Datensätze in einer Liste löschen. Es soll die Spalte A verglichen werden. Die Spaltenüberschrift soll nicht sortiert bzw. gelöscht werden.

Sub DoppelteSätzeElimimieren()
'doppelte Eiträge löschen
Sheets("D").Activate
'zuerst sortieren
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), _
 Order1:=xlAscending, _
 Header:=xlYes, OrderCustom:=1, _
 MatchCase:=False, _
 Orientation:=x1TopToBottom
' jetzt löschen
Range("A1").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = _
ActiveCell.Offset(1, 0).Value _
Then ActiveCell.EntireRow.Delete _
Else AvtiveCell.Offset(1, 0).Select
Loop
End Sub
Ich habe das Makro exakt übernommen und nur den Blattnamen angepasst aber es funktioniert nicht. Wo liegt der Fehler?. Das Sortieren klappt schon nicht. Ich bekomme immer die Meldung "400" ?
Ich muß dazusagen, dass ich grade unter 2007 arbeite aber die Mappe auch unter 2003 laufen muß.
Währe super, wenn Ihr mier sogar am Wochenende helfen könntet.
Viele Grüße André

  

Betrifft: AW: Doppelte Einträge löschen von: Josef Ehrensberger
Geschrieben am: 07.01.2012 14:11:12


Hallo André,

Literatur von einem gewissen Bernd H.?

Probier es mal so, ohne Schleife.

Sub DoppelteSätzeElimimieren()
  Dim rng As Range, strRange As String
  Dim lngCalc As Long
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lngCalc = .Calculation
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With
  
  With Sheets("D")
    .Columns(2).Insert
    strRange = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row).Address
    .Range("B2:B" & .Cells(.Rows.Count, 1).End(xlUp).Row).Formula = "=IF(OR(A2="""",COUNTIF($A$2:A2,A2)>1),TRUE(),"""")"
    On Error Resume Next
    Set rng = .Columns(2).SpecialCells(xlCellTypeFormulas, xlLogical)
    On Error GoTo 0
    If Not rng Is Nothing Then rng.EntireRow.Delete
    .Columns(2).Delete
  End With
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "Sub 'DoppelteSätzeElimimieren'" & vbLf & String(40, "=") & vbLf & vbLf & _
        IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & "Fehlernummer:" & vbTab & _
        .Number & vbLf & vbLf & "Beschreibung:" & vbTab & .Description & vbLf, vbExclamation, "Fehler in Modul - Modul2"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = lngCalc
    .DisplayAlerts = True
  End With
  
  Set rng = Nothing
End Sub




« Gruß Sepp »



  

Betrifft: AW: Doppelte Einträge löschen von: André Zschech
Geschrieben am: 07.01.2012 14:22:25

Das buch ist von Bernd H.
Haste Recht.
Dein Makro funktioniert tadellos!!!!
Großartig, du hast mir sehr geholfen.
Danke und schöne Wochenende!


Beiträge aus den Excel-Beispielen zum Thema "Doppelte Einträge löschen"