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 2019 / 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.
|