Dim i&, j&, Z1&, u&, Doppelt$(), flgFound() As Boolean
 
  u = UBound(Liste)
  ReDim Doppelt(u), flgFound(u)
  Z1 = -1
  For i = 0 To u - 1
    If flgFound(i) = False Then
      For j = i + 1 To u
        If flgFound(j) = False Then
          If Liste(i) = Liste(j) Then
            flgFound(i) = True
            flgFound(j) = True
          End If
        End If
      Next j
      If flgFound(i) = True Then
        Z1 = Z1 + 1
        Doppelt(Z1) = Liste(i)
      End If
    End If
  Next i
  Erase flgFound
  If Z1 >= 0 Then
    ReDim Preserve Doppelt(Z1)
    MsgBox "Doppelt:" & vbCr & Join(Doppelt, vbCr)
  Else
    MsgBox "Nichts gefunden."
  End If

Gruss,

Zardoz