AW: Doppelten Wert finden->dann x schreiben
19.11.2020 18:44:37
Daniel
Hi
naja zunächst einmal zum Verständnis:
es gibt kein Excel-Team.
jeder, der dir hier antwortet, ist Forumsteilnehmer genauso wie du selbst.
es gibt keinen Unterschied zwischen denen die Fragen stellen und denen die Antworten (ausser vielleicht das Excelwissen, aber mehr nicht.)
der Code für deinen Wunsch sieht so aus.
Zelle A1 sollte gefüllt sein.
Ich gehe davon aus, dass zu beginn nur die schwarzen "x" gesetzt sind.
Sub DoppelteMarkieren()
Dim dicZeilen As Object
Dim dicHatX As Object
Dim arrC
Dim arrE
Dim K
Dim ZE
Dim z As Long
arrC = ActiveSheet.UsedRange.Columns(3)
arrE = ActiveSheet.UsedRange.Columns(5)
Set dicZeilen = CreateObject("scripting.dictionary")
Set dicHatX = CreateObject("scripting.dictionary")
For z = 1 To UBound(arrC, 1)
dicZeilen(arrC(z, 1)) = dicZeilen(arrC(z, 1)) & "-" & z
If arrE(z, 1) = "x" Then dicHatX(arrC(z, 1)) = z
Next
For Each K In dicZeilen.keys
If dicHatX(K) "" Then
For Each ZE In Split(Mid(dicZeilen(K), 2), "-")
ZE = CLng(ZE)
If ZE dicHatX(K) Then
With ActiveSheet.UsedRange.Cells(ZE, 5)
.Value = "x"
.Font.Color = vbRed
End With
End If
Next
End If
Next
End Sub
Code ist getestet und funktioniert mit einer Datei, die ich nach deinen Vorgaben erstellt habe
Gruß Daniel