Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.05.2024 11:17:06
Hyperlink zu Bild in Zelle
17.05.2024 11:15:40
Spalte und Makros gleichzeitig verschieben
17.05.2024 11:03:10
Ganze Zahl in Ganz-Zahl Kombinationen aufteilen (ohne Rest)
17.05.2024 10:40:53
Tabellen (formatiert) über VBA auswählen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1956to1960
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1956to1960
1956to1960
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Doppelte in mehreren Spalten

Doppelte in mehreren Spalten
31.12.2023 12:52:41
wolfgang
Guten Tag allerseits,
ich wünsche allen einen schönen Übergang ins neue Jahr !

Ich habe dieses Makro, für die Überprüfung ob doppelte in der aktiven Spalte vorhanden
sind, wenn ja, dann wurden dies rot eingefärbt. 
Public Sub Doppelte_in_Spalte()



Dim Z As Long

   Z = Range("A2").End(xlDown).Row

         ActiveSheet.Range(Cells(3, 1), Cells(Z, 14)).Sort Key1:=Cells(3, ActiveCell.Column), Order1:=xlAscending, Header:=xlNo

   Intersect(ActiveCell.EntireColumn, Range("3:" & Z)).Select

  

 Selection.FormatConditions.AddUniqueValues

    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

    Selection.FormatConditions(1).DupeUnique = xlDuplicate

    With Selection.FormatConditions(1).Font

        .Color = -16383844

        .TintAndShade = 0

    End With

    With Selection.FormatConditions(1).Interior

        .PatternColorIndex = xlAutomatic

        .Color = 11577598 ' bisher        13551615

        .TintAndShade = 0

    End With

End Sub

Natürlich unter Hilfe des Forums.

Jetzt würde ich gern im Bereich: ActiveSheet.Range(Cells(3, 1), Cells(Z, 14)
die Zeilen Rot einfärben lassen, wenn die Spalten E und H, I J und K gleich sind.
Daher wenn in der Spalte E doppelt ist sollte auch nach Rechts die Zeile überprüft werden H,I,J,K .


gruß wolfgang

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Änderung !
31.12.2023 14:11:50
wolfgang
Hallo zusammen,
es würde mir genügen, wenn die rote Zeile von Spalte E - K rot
eingefärbt wird.

gruß wolfgang
AW: Änderung !
01.01.2024 15:20:10
Piet
Hallo

was passiert, wenn du Intersect(xxxxx).Select wie vorher bei Sort ersetzt?
ActiveSheet.Range(Cells(3, 1), Cells(Z, 14)).Select

mfg Piet
Leider nichts...
01.01.2024 15:45:27
wolfgang
Hallo Piet,
danke das Du dich kümmerst.... 
    Intersect(ActiveCell.EntireColumn, Range(Cells(3, 2), Cells(Z, 14))).Select


danach geht es ja so weiter: 
 Selection.FormatConditions.AddUniqueValues

    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

    Selection.FormatConditions(1).DupeUnique = xlDuplicate

    With Selection.FormatConditions(1).Font

        .Color = -16383844

        .TintAndShade = 0

    End With

    With Selection.FormatConditions(1).Interior

        .PatternColorIndex = xlAutomatic

        .Color = 11577598 ' bisher        13551615

        '11577598

        .TintAndShade = 0

    End With


nach wie vor werden die doppelten Namen in der Spalte E rot makiert.
WICHTIG es soll ja nur die Zeile von den doppelten in Spalte E nach rechts auch rot gefärbt werden !
KEINE doppelten in den Spalten bis K !

GRUND, so kann man besser sehen ob bei den gefundenen Namen in Spalte E auch die Adresse gleich ist.

gruß wolfgang
Anzeige
AW: Doppelte in mehreren Spalten
31.12.2023 16:51:05
Piet
Hallo

probiere es bitte mal so, ohne Gewähr das es klappt.
Range(Cells(ActiveCell.Row, 5), Range("K" & z)).Select 'von E - K

mfg Piet
AW: Doppelte in mehreren Spalten
02.01.2024 16:25:41
Piet
Hallo Wolfgang

ich kann dir leider nicht die Lösung anbieten, die du dir erhoffst. Da müssten sich die Kollegen drum kümmern. > 2007
Meine alte Excel 2003 Version kommt mit der Bedingten Formatierung nicht klar, Laufzeitfehler, einige Befehle unbekannt!
Error bei - AddUniqueValues und dem Befehl - .DupeUnique = xlDuplicate -- Da steigt mein altes Excel aus! Schliest Datei.

Anbieten kann ich dir eine normale Markierung mit Interior.ColorIndex = 22. Das funktioniert wenigstens.
Hier mein Code, der in deiner Beispieldatei funktioniert. Starten kann man ihn mit Button.

mfg Piet 

Option Explicit      '2.1.2024  Piet  für Herber Forum

Dim AC As Range, lz1 As Long

Const IColor = 22



Sub Doppelte_markieren()

    'Lastzell ab A2 suchen, Innenfarbe löschen

    lz1 = Range("A2").End(xlDown).Row

    Range("E3:K" & lz1).Interior.ColorIndex = xlNone



    'Sortieren ab Zeile 3, OHNE Überschrift!

    Range("E3:K" & lz1).Sort Key1:=Range("E3"), order1:=xlAscending, Header:=xlNo, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom



    'Schleife für Deoppelnamen markieren

    For Each AC In Range("E3:E" & lz1)

        If AC.Value = AC.Cells(2, 1) Then

           AC.Offset(0, 1).Resize(2, 6).Interior.ColorIndex = IColor

        End If

    Next AC

End Sub



Sub Innenfarbe_löschen()

    lz1 = Cells(Rows.Count, 1).End(xlUp).Row

    Range("E3:K" & lz1).Interior.ColorIndex = xlNone

End Sub
Anzeige
Danke Piet -)
02.01.2024 18:51:18
wolfgang
Guten Abend Piet,
einwandfrei, ich lasse mein altes Makro laufen und danach deins klappt !

Danke !

mfg wolfgang
Guten Morgen, erst mal...ALLEN ein gesundes neues Jahr !
01.01.2024 11:48:33
wolfgang
Guten Morgen Piet,
erst mal ein gesundes neues Jahr !

Leider klappt es nicht.
gruß wolfgang
Zur besseren Übersicht kompl.Makro
01.01.2024 15:52:24
wolfgang
Hallo,
hier nochmal das kompl. Makro: 
Public Sub Doppelte_in_Spalte()



Dim Z As Long

 Z = Range("A2").End(xlDown).Row



    ' muss = Header:=xlYes sonst blendet die obere Zeile aus !

    Selection.Sort Key1:=Cells(3, ActiveCell.Column), order1:=xlAscending, Header:=xlYes, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom



    'Range(Cells(ActiveCell.Row, 5), Range("K" & z)).Select      'von E - K

   ' Intersect(ActiveCell.EntireColumn, Range(Cells(ActiveCell.Row, ActiveCell.Column), Range("K" & Z)).Select).Select  'hiermit wird Spalte E selectiert

 Intersect(ActiveCell.EntireColumn, Range("3:" & Z)).Select                          ' Orginal hiermit wird Spalte E selectiert



    Selection.FormatConditions.AddUniqueValues

    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

    Selection.FormatConditions(1).DupeUnique = xlDuplicate

    With Selection.FormatConditions(1).Font

        .Color = -16383844

        .TintAndShade = 0

    End With

    With Selection.FormatConditions(1).Interior

        .PatternColorIndex = xlAutomatic

        .Color = 11577598 ' bisher        13551615

        '11577598

        .TintAndShade = 0

    End With

    ActiveSheet.Range("E3").Select

End Sub


gruß wolfgang
Anzeige
AW: Zur besseren Übersicht kompl.Makro
01.01.2024 19:55:01
Piet
Hallo Wolfgang

ich vermute mal in der Nachbarzelle bedindet sich auch Bedingte Formatierung? Dann könnte es so gehen.
Dim Bereich as String
Bereich = Intersect(ActiveCell.EntireColumn, Range("3:" & z)).Address
Range(Bereich, Range(Bereich).Offset(0, 1)).Select

Wenn die Nachbarzelle KEINE Bedingte Formatierung hat, könntest du sie evtl. so ansprechen.
With Selection.Offset(0, 1) -- d.h. die vorherige With Selection mit Offset(0,1) wiederholen!
Würde mich freuen wenn einer von beiden Vorschlägen klappt.

mfg Piet
Anbei Muster
02.01.2024 12:03:09
wolfgang
Guten Morgen Piet,
ein gesundes neues Jahr !
Anbei mal Musterdatei, Tabelle1, Tabelle: "so sollte es sein", damit man zur besseren Übersicht
die Adressen bearbeiten kann.
https://www.herber.de/bbs/user/165775.xlsm

gruß wolfgang
Anzeige

Links zu Excel-Dialogen

Frame

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige