Thema Datum  Von Nutzer Rating
Antwort
23.04.2024 08:48:03 Ulrich Paul
NotSolved
23.04.2024 10:29:16 Ben
NotSolved
23.04.2024 21:06:14 ralf_b
NotSolved
Blau UÜserForm
 24.04.2024 08:38:54 Ulrich Paul
NotSolved
24.04.2024 14:46:08 Gast39910
NotSolved
24.04.2024 21:33:14 Ulrich Paul
NotSolved
30.04.2024 16:08:16 Gast70852
Solved
03.05.2024 10:26:42 Alwin Weisangler
NotSolved
03.05.2024 12:18:37 Alwin
NotSolved
03.05.2024 14:03:49 Alwin Weisangler
Solved
03.05.2024 19:34:59 Ulrich Paul
Solved
03.05.2024 19:41:28 Gast11408
Solved

Ansicht des Beitrags:
Von:
Ulrich Paul		 Datum:
24.04.2024 08:38:54		 Views:
62		 Rating:
     
Antwort:
  Ja
Thema:
UÜserForm

Das habe ich gefunden:

Sub xlph_Doppelte_Markieren(rng As Range, arCols() As Variant)
    Dim ar      As Variant
    Dim i       As Long, Z_Offset As Long
    Dim k       As Integer
    Dim D       As Object
    Dim sAdr    As String, sVgl  As String
    
    On Error GoTo ENDE
    Application.ScreenUpdating = False
    
    Set D = CreateObject("Scripting.Dictionary")
    
    rng.Parent.Cells.Interior.ColorIndex = xlColorIndexNone
    
    Z_Offset = rng.Row - 1
    ar = rng.Value
    
    For i = 1 To UBound(ar)
        sVgl = ""
        For k = 0 To UBound(arCols)
            sVgl = sVgl & "~" & ar(i, arCols(k))
        Next
        D(sVgl) = D(sVgl) + 1
        If D(sVgl) > 1 Then
            If Len(sAdr & ",A" & i + Z_Offset) > 256 Then
                Intersect(rng, Range(Mid(sAdr, 2)).EntireRow).Interior.ColorIndex = 4
                sAdr = ""
            End If
            sAdr = sAdr & ",A" & i + Z_Offset
        End If
    Next
    If Len(sAdr) Then Intersect(rng, Range(Mid(sAdr, 2)).EntireRow).Interior.ColorIndex = 4
    
ENDE:
    If Err Then MsgBox Err.Description, , "Fehler: " & Err
    Application.ScreenUpdating = True
End Sub

 

 

Wäre schön wenn es machbar wird

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
23.04.2024 08:48:03 Ulrich Paul
NotSolved
23.04.2024 10:29:16 Ben
NotSolved
23.04.2024 21:06:14 ralf_b
NotSolved
Blau UÜserForm
 24.04.2024 08:38:54 Ulrich Paul
NotSolved
24.04.2024 14:46:08 Gast39910
NotSolved
24.04.2024 21:33:14 Ulrich Paul
NotSolved
30.04.2024 16:08:16 Gast70852
Solved
03.05.2024 10:26:42 Alwin Weisangler
NotSolved
03.05.2024 12:18:37 Alwin
NotSolved
03.05.2024 14:03:49 Alwin Weisangler
Solved
03.05.2024 19:34:59 Ulrich Paul
Solved
03.05.2024 19:41:28 Gast11408
Solved