Quelltexterklärung?

Sub DoppelteEintraegeLoeschen()
  
  Dim colUnique As New Collection
  Dim lngAbZeile As Long
  Dim lngArr As Long
  Dim lngC As Long
  Dim lngCalc As Long
  Dim lngDup As Long
  Dim lngMaxArrays As Long
  Dim lngZ As Long
  Dim lngZeile As Long
  Dim lngZeilenArray As Long
  Dim lngZeilenBereich As Long
  Dim rngArea As Range
  Dim rngAuswahl As Range
  Dim rngC As Range
  Dim rngDel() As Range
  Dim rngSel As Range
  Dim strSuchbereich As String
  Dim strZeile As String
  Dim varAuswahl() As Variant
  Dim varC As Variant
  Set rngSel = Selection.EntireColumn
  lngZeilenBereich = ActiveSheet.UsedRange.Rows.Count
On Error GoTo FehlerBehandlung
  lngCalc = Application.Calculation
  Set rngAuswahl = Application.Intersect(Selection.EntireColumn, ActiveSheet.UsedRange)
  strSuchbereich = rngAuswahl.Address(0, 0)
  lngAbZeile = Abs(CLng(Application.InputBox( _
    vbLf & "Ab welcher Zeile soll geprüft werden?", "Prüfbereich festlegen", 2, , , , , 1)))  
  If lngAbZeile > 0 And lngAbZeile <= lngZeilenBereich Then
    Set rngAuswahl = Application.Intersect(Rows(lngAbZeile & ":" & lngZeilenBereich), rngSel)  
  Else
    MsgBox "Die Zeile " & lngAbZeile & " liegt außerhalb des Bereichs """ & strSuchbereich & """!"  
    Exit Sub
  End If
  lngZeilenArray = lngZeilenBereich - lngAbZeile + 1
  rngAuswahl.Select
  lngArr = 1
  ReDim rngDel(lngArr)
  lngMaxArrays = lngZeilenBereich / 50
  strSuchbereich = rngAuswahl.Address(0, 0)
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  For Each rngArea In rngAuswahl.Areas
    For Each rngC In rngArea.Columns
      lngC = lngC + 1
      ReDim Preserve varAuswahl(1 To lngC)
      varAuswahl(lngC) = rngC.Value
    Next rngC
  Next rngArea
  colUnique.Add 0, "" 'wenn 1. Leerzeile auch berücksichtigt werden soll  
  For lngZeile = 1 To lngZeilenArray
    strZeile = ""  
    For lngZ = 1 To lngC
      strZeile = strZeile & CStr(varAuswahl(lngZ)(lngZeile, 1))
    Next lngZ
    colUnique.Add lngZeile, strZeile
  Next lngZeile
  Set rngDel(0) = rngDel(1)
  lngArr = lngArr + (rngDel(lngArr) Is Nothing)
  If lngArr > 1 Then
    For lngZ = 2 To lngArr
      Set rngDel(0) = Application.Union(rngDel(0), rngDel(lngZ))
    Next lngZ
  End If
  lngDup = rngDel(0).Cells.Count / 256
  Application.Intersect(rngSel, rngDel(0)).Select
  Application.ScreenUpdating = True
  If MsgBox("Es wurden " & lngDup & " Duplikate im Bereich" & vbLf & _  
            strSuchbereich & vbLf & _
            "gefunden." & vbLf & vbLf & "Sollen sie jetzt gelöscht werden?", _  
            vbQuestion Or vbYesNo Or vbDefaultButton2) = vbYes Then
    Application.ScreenUpdating = False
    For lngZ = lngArr To 1 Step -1
        rngDel(lngZ).Delete
    Next lngZ
    rngSel.Select
    Application.ScreenUpdating = True
  End If
FehlerBehandlung:
  Select Case Err.Number
    Case 457
      If rngDel(lngArr) Is Nothing Then
        Set rngDel(lngArr) = Rows(lngZeile + lngAbZeile - 1)
      Else
        Set rngDel(lngArr) = Application.Union(rngDel(lngArr), Rows(lngZeile + lngAbZeile - 1))
      End If
      If rngDel(lngArr).Areas.Count = lngMaxArrays Then
        lngArr = lngArr + 1
        ReDim Preserve rngDel(lngArr)
      End If
      Resume Next
    Case 13, 91
        MsgBox "Im Bereich" & vbLf & vbLf & """" & strSuchbereich & """" & vbLf & vbLf & "gibt es keine Duplikate."  
    Case Is > 0
      MsgBox "Fehlernummer: " & Err.Number & vbLf & vbLf & _  
            "Felerbeschreibung: " & Err.Description  
      'für Entwicklung zum Testen  
'      Application.Calculation = lngCalc  
'      On Error GoTo 0  
'      Resume  
  End Select
  Application.Calculation = lngCalc
End Sub