Datei doppelt in VBA-Ansicht!
#11
Ja, stimmt, das würde jetzt zu weit führen.
Ebenso schönes Wochenende.
Top
#12
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
Top
#13
Anhand des Codes würde ich sagen, daran liegt es nicht.
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste