Registriert seit: 25.04.2016
Version(en): 2013
Ja, stimmt, das würde jetzt zu weit führen. Ebenso schönes Wochenende.
Registriert seit: 27.04.2014
Version(en): Privat: Office Home & Business 2024 / Arbeit: MS365
Hallo zusammen, vielen Dank für die Infos, hier meine Codes: Das hier hinter Blatt "Daten": Code: Option Explicit ' Variablendefinition erforderlich Private Sub Worksheet_Change(ByVal Target As Range) Dim RaBereich As Range ' Variable für Bereich Dim RaZelle As Range ' Variable für Zelle Set RaBereich = Columns(1) ' Bereich der Wirksamkeit Set RaBereich = Intersect(RaBereich, Range(Target.Address)) If Not RaBereich Is Nothing Then Application.EnableEvents = False ActiveSheet.Unprotect Password:="999" For Each RaZelle In RaBereich If RaZelle.Row > 2 Then If RaZelle <> "" Then Range(Cells(3, 11), Cells(RaZelle.Row, 11)).Formula = Cells(3, 11).Formula Range(Cells(3, 12), Cells(RaZelle.Row, 12)).Formula = Cells(3, 12).Formula Range(Cells(3, 13), Cells(RaZelle.Row, 13)).Formula = Cells(3, 13).Formula Range(Cells(3, 14), Cells(RaZelle.Row, 14)).Formula = Cells(3, 14).Formula Range(Cells(3, 15), Cells(RaZelle.Row, 15)).Formula = Cells(3, 15).Formula Range(Cells(3, 16), Cells(RaZelle.Row, 16)).Formula = Cells(3, 16).Formula Range(Cells(3, 17), Cells(RaZelle.Row, 17)).Formula = Cells(3, 17).Formula Range(Cells(3, 18), Cells(RaZelle.Row, 18)).Formula = Cells(3, 18).Formula Range(Cells(3, 19), Cells(RaZelle.Row, 19)).Formula = Cells(3, 19).Formula Range(Cells(3, 20), Cells(RaZelle.Row, 20)).Formula = Cells(3, 20).Formula Range(Cells(3, 21), Cells(RaZelle.Row, 21)).Formula = Cells(3, 21).Formula Range(Cells(3, 22), Cells(RaZelle.Row, 22)).Formula = Cells(3, 22).Formula Range(Cells(3, 23), Cells(RaZelle.Row, 23)).Formula = Cells(3, 23).Formula Range(Cells(3, 24), Cells(RaZelle.Row, 24)).Formula = Cells(3, 24).Formula Range(Cells(3, 25), Cells(RaZelle.Row, 25)).Formula = Cells(3, 25).Formula Range(Cells(3, 26), Cells(RaZelle.Row, 26)).Formula = Cells(3, 26).Formula Range(Cells(3, 27), Cells(RaZelle.Row, 27)).Formula = Cells(3, 27).Formula Range(Cells(3, 28), Cells(RaZelle.Row, 28)).Formula = Cells(3, 28).Formula Range(Cells(3, 29), Cells(RaZelle.Row, 29)).Formula = Cells(3, 29).Formula Range(Cells(3, 30), Cells(RaZelle.Row, 30)).Formula = Cells(3, 30).Formula Range(Cells(3, 31), Cells(RaZelle.Row, 31)).Formula = Cells(3, 31).Formula Else Cells(RaZelle.Row, 2).Value = "" Cells(RaZelle.Row, 3).Value = "" Cells(RaZelle.Row, 4).Value = "" Cells(RaZelle.Row, 5).Value = "" Cells(RaZelle.Row, 6).Value = "" Cells(RaZelle.Row, 7).Value = "" Cells(RaZelle.Row, 8).Value = "" Cells(RaZelle.Row, 9).Value = "" Cells(RaZelle.Row, 10).Value = "" Cells(RaZelle.Row, 11).Formula = "" Cells(RaZelle.Row, 12).Formula = "" Cells(RaZelle.Row, 13).Formula = "" Cells(RaZelle.Row, 14).Formula = "" Cells(RaZelle.Row, 15).Formula = "" Cells(RaZelle.Row, 16).Formula = "" Cells(RaZelle.Row, 17).Formula = "" Cells(RaZelle.Row, 18).Formula = "" Cells(RaZelle.Row, 19).Formula = "" Cells(RaZelle.Row, 20).Formula = "" Cells(RaZelle.Row, 21).Formula = "" Cells(RaZelle.Row, 22).Formula = "" Cells(RaZelle.Row, 23).Formula = "" Cells(RaZelle.Row, 24).Formula = "" Cells(RaZelle.Row, 25).Formula = "" Cells(RaZelle.Row, 26).Formula = "" Cells(RaZelle.Row, 27).Formula = "" Cells(RaZelle.Row, 28).Formula = "" Cells(RaZelle.Row, 29).Formula = "" Cells(RaZelle.Row, 30).Formula = "" Cells(RaZelle.Row, 31).Formula = "" End If End If Next RaZelle End If Set RaBereich = Nothing ' Variable leeren Call DoppelteMarkieren Application.EnableEvents = True ActiveSheet.Protect Password:="999" End Sub
und das hier in ein Modul: Code: Sub DoppelteMarkieren() Dim Bereich As Range Set Bereich = Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Row) Bereich.FormatConditions.AddUniqueValues Bereich.FormatConditions(Bereich.FormatConditions.Count).SetFirstPriority Bereich.FormatConditions(1).DupeUnique = xlDuplicate With Bereich.FormatConditions(1).Font .Color = -16383844 .TintAndShade = 0 End With With Bereich.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 13551615 .TintAndShade = 0 End With Bereich.FormatConditions(1).StopIfTrue = False Set Bereich = Nothing End Sub
Ist da etwas dabei, dass zu mein Problem führt? Vielen Dank VG Alexandra
Registriert seit: 25.04.2016
Version(en): 2013
Anhand des Codes würde ich sagen, daran liegt es nicht.
|