Ich benötige ein VBA "schnipsel", um in einem markierten, oder gefiltertem Bereich doppelte Einträge zu markieren.
Danke für Eure Hilfe.
Scotty
If Not c.EntireRow.Hidden Then c.Interior.Color = vbYellow
Gruß MatthiasSub Schnipsel()
Dim r As Range, c As Range
Set r = Selection
For Each c In r
If WorksheetFunction.CountIfs(r, c) > 1 Then
If Not c.EntireRow.Hidden Then c.Interior.Color = vbYellow
End If
Next c
Set r = Nothing: Set c = Nothing
End Sub
Bei mir geht es.D | E | F | |
3 | |||
6 | 3 | b | |
7 | 4 | b | |
9 | 6 | b | |
13 | 10 | b | |
20 | 1 | b | |
21 | 2 | b | |
22 | 3 | b | |
24 | 5 | b | |
26 | 7 | b | |
27 | 8 | b | |
28 | 9 | b | |
29 | 10 | b | |
30 | 11 | b | |
33 | 14 | b | |
34 | 15 | b | |
35 | 16 | b | |
36 | 16 | b | |
37 | 10 | b |
D | E | F | |
3 | |||
4 | 1 | a | |
5 | 2 | a | |
6 | 3 | b | |
7 | 4 | b | |
8 | 5 | a | |
9 | 6 | b | |
10 | 7 | a | |
11 | 8 | a | |
12 | 9 | a | |
13 | 10 | b | |
14 | 11 | a | |
15 | 12 | a | |
16 | 13 | a | |
17 | 14 | a | |
18 | 15 | a | |
19 | 16 | a | |
20 | 1 | b | |
21 | 2 | b | |
22 | 3 | b | |
23 | 4 | a | |
24 | 5 | b | |
25 | 6 | a | |
26 | 7 | b | |
27 | 8 | b | |
28 | 9 | b | |
29 | 10 | b | |
30 | 11 | b | |
31 | 12 | a | |
32 | 13 | a | |
33 | 14 | b | |
34 | 15 | b | |
35 | 16 | b | |
36 | 16 | b | |
37 | 10 | b |
Sub DoppelteMarkieren()
Dim Zelle As Range
Dim Zähler As Object
Set Zähler = CreateObject("scripting.dictionary")
With Intersect(Selection.Worksheet.UsedRange, Selection.SpecialCells(xlCellTypeVisible))
For Each Zelle In .Cells
Zähler(Zelle.Value) = Zähler(Zelle.Value) + 1
Next
For Each Zelle In .Cells
If Zähler(Zelle.Value) > 1 Then Zelle.Interior.Color = vbRed
Next
End With
End Sub
alternativ gäbe es noch eine Makrofreie variante (wobei die recht rechenaufwendig ist)=Teilergebnis(3;F4)
2. richte für die Zellen ab D4 eine Bedingte Formatierung mit dieser Formel als Regel ein:
=WENN(G4=1;ZÄHLENWENNS(G:G;1;D:D;D4)>1)
Gruß Daniel