Hallo liebe Experten, in einer alten Tabelle habe ich eine UserForm gefunden, die fast das macht, was ich möchte. Leider ist aber außer der Herkunft dort kein Kommentar vorhanden. Wer wäre wohl so freundlich die UF gründlich zu kommentieren, damit auch ein "Nicht"Experte nachvollziehen kann was dort abläuft. Eine Ergänzung habe ich aber jetzt schon, die Markierung der doppelten Einträge zeigt nur die Wiederholungen, aber nicht den ersten Eintrag dazu. Lässt sich das noch einbauen? Viele Grüße Ulrich

Windows 11,

Microsoft® Excel® 2021 MSO (Version 2403 Build 16.0.17425.20176) 64 Bit

'gefunden: http://www.office-loesung.de/ftopic566740_0_0_asc.php#2400220

Option Explicit

Private Sub UserForm_Initialize()
    Set Bereich = Range("A3").CurrentRegion
    RefEdit1.Value = Bereich.Address
    With Bereich
        If .Columns.Count > 1 Then
            ListBox1.Column = .Rows(1).Value
        Else
            ListBox1.AddItem .Rows(1).Value
        End If
    End With
End Sub

Private Sub CommandButton1_Click()
    Dim ar() As Variant
    Dim i As Integer
    Dim n As Integer
    n = -1
    With ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                n = n + 1
                ReDim Preserve ar(n)
                ar(n) = i + 1
            End If
        Next
    End With
    If n < 0 Then Exit Sub
    Call xlph_Doppelte_Markieren(Bereich, ar())
End Sub

Private Sub CommandButton2_Click()
    With Bereich
        If .Columns.Count > 1 Then
            ListBox1.Column = .Rows(1).Value
        Else
            ListBox1.AddItem .Rows(1).Value
        End If
    End With
End Sub

Private Sub CommandButton3_Click()
  Unload frmDoppelteB_Markieren1
End Sub

Private Sub CommandButton4_Click()
    Cells.Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A1").Select
End Sub

Private Sub RefEdit1_Enter()
    ListBox1.Clear
End Sub

Private Sub RefEdit1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim rng As Range
    On Error Resume Next
    Set rng = Range(RefEdit1)
    If Err Or rng.Count < 2 Then
        MsgBox "Kein gültiger Bereich!", , "Bereichs-Wahl"
        RefEdit1 = Split(Bereich.Address(, , , True), "!")(1)
    Else
        Set Bereich = rng
    End If
End Sub