Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Duplikate in Spalte markieren - unterschiedliche Duplikate in unterschiedlichen Farben (VBA Excel 2007)

Frage Entwicklung VB for Applications

Mitglied: Fusselfrei

Fusselfrei (Level 1) - Jetzt verbinden

14.12.2011, aktualisiert 09:23 Uhr, 8822 Aufrufe, 4 Kommentare

Guten Tag zusammen!

Ich bitte um Hilfe bei folgender Fragestellung:

Eine Lösung zum farblichen Markieren von Duplikaten in einer Spalte (z.B. C) in z.B. rot ist beispielsweise:

01.
Sub Doppelte_markieren_Spalte_C() 
02.
 
03.
'angelehnt an: http://www.ms-office-forum.net/forum/sitemap/index.php?t-277131.html 
04.
 
05.
Dim lngZeile As Long 
06.
Dim lngEnde As Long 
07.
Dim i As Integer 
08.
     
09.
lngEnde = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row 
10.
For lngZeile = 1 To ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row 
11.
    If Application.CountIf(Range("C1:C" & lngEnde), Range("C" & lngZeile)) > 1 Then 
12.
        Range("C" & lngZeile).Interior.ColorIndex = 3 
13.
    End If 
14.
Next lngZeile 
15.
 
16.
End Sub
Ich möchte jedoch unterschiedliche Duplikate in unterschiedlichen Farben markieren, wie z.B.

PAT-001980 -> rot
PAT-001980 -> rot
PAT-001980 -> rot
PAT-001981
PAT-001982 -> gelb
PAT-001982 -> gelb

Vielen Dank im Voraus!

Fusselfrei
Mitglied: 76109
14.12.2011 um 20:32 Uhr
Hallo Fusselfrei!

Sollte in etwa so gehen:
01.
Sub Doppelte_markieren_Spalte_C() 
02.
 
03.
'angelehnt an: http://www.ms-office-forum.net/forum/sitemap/index.php?t-277131.html 
04.
 
05.
    Dim lngZeile As Long 
06.
    Dim lngEnde As Long 
07.
    Dim strValue As String 
08.
     
09.
    Dim objDupList As Object 
10.
    Dim arrFarben As Variant 
11.
    Dim intFarben As Integer 
12.
     
13.
    arrFarben = Array(3, 5, 7, 4)	'Aufzählung der ColorIndex-Werte entsprechend anpassen 
14.
     
15.
    Set objDupList = CreateObject("Scripting.Dictionary")    'Liste der Duplikate (Key) mit ColorIndex (Item) 
16.
     
17.
    lngEnde = Cells(Rows.Count, 3).End(xlUp).Row 
18.
     
19.
    Columns("C:C").Interior.ColorIndex = xlNone	'Alle Farben in Spalte C zurücksetzen 
20.
     
21.
    For lngZeile = 1 To lngEnde 
22.
        strValue = Cells(lngZeile, "C").Text 
23.
        If strValue <> "" Then   	'Test Zelle nicht Leer 
24.
            If Application.CountIf(Range("C1:C" & lngEnde), strValue) > 1 Then 
25.
                If objDupList.Exists(strValue) Then	 
26.
                    Cells(lngZeile, "C").Interior.ColorIndex = objDupList.Item(strValue) 
27.
                Else 
28.
                    Cells(lngZeile, "C").Interior.ColorIndex = arrFarben(intFarben) 
29.
                    objDupList.Add strValue, arrFarben(intFarben) 
30.
                    intFarben = intFarben + 1 
31.
                    If intFarben > UBound(arrFarben) Then intFarben = 0 
32.
                End If 
33.
            End If 
34.
        End If 
35.
    Next 
36.
End Sub
Wobei sich die Farben wiederholen, sofern mehr Duplikate als Farben im Farben-Array (arrFarben) vorhanden sind.

Gruß Dieter
Bitte warten ..
Mitglied: Fusselfrei
14.12.2011 um 21:45 Uhr
Hallo Dieter!

Das ist perfekt!


Vielen herzlichen Dank

Fusselfrei
Bitte warten ..
Mitglied: 76109
15.12.2011 um 16:20 Uhr
Hallo Fusselfrei!

Yepp, gern geschehen

Gruß Dieter
Bitte warten ..
Mitglied: SnackBar
15.05.2013 um 12:35 Uhr
Hi zusammen,

ich würde gerne wissen was ich machen muss damit er mir wie folgt die Spalte markiert.

PAT-001980 -> rot
PAT-001980 -> rot
PAT-001980 -> rot
PAT-001981 -> grün
PAT-001982 -> rot
PAT-001982 -> rot
PAT-001983 -> grün
PAT-001983 -> grün
PAT-001984 -> rot
PAT-001985 -> grün

Also sobald ein Zahlenwechsel erfolgt die Farbe wechselt wird.

Danke

Gruß Andre
Bitte warten ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(2)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
Microsoft Office
gelöst Verschieben von Zellinformation in andere Spalte (per VBA) excel 2010 (5)

Frage von thomas1972 zum Thema Microsoft Office ...

VB for Applications
Bilder vom LDAP in VBA - Excel (3)

Frage von Roadrunner777 zum Thema VB for Applications ...

VB for Applications
gelöst VBA Excel Recordset - Abfrage auf SQL-Server (4)

Frage von Aximand zum Thema VB for Applications ...

Heiß diskutierte Inhalte
LAN, WAN, Wireless
gelöst Server erkennt Client nicht wenn er ausserhalb des DHCP Pools liegt (28)

Frage von Mar-west zum Thema LAN, WAN, Wireless ...

Windows Server
Server 2008R2 startet nicht mehr (Bad Patch 0xa) (18)

Frage von Haures zum Thema Windows Server ...

Outlook & Mail
Outlook 2010 findet ost datei nicht (18)

Frage von Floh21 zum Thema Outlook & Mail ...