Ist es möglich, Formeln in G3:G5000 auszublenden, ohne Blattschutz?
Gruß
Heinz
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("G3:G8000").FormulaR1C1 = "=IF(RC6="""","""",VLOOKUP(RC6,Artikeln!R2C1:R49999C5,3))"
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngSumColor As Range
If Target.Column = 1 And Target.Row > 1 Then
Application.EnableEvents = False
If IsDate(Target) Then
Range(Target.Offset(-1, 0), Target.Offset(-1, 7)).Interior.ColorIndex = 37
Range(Target.Offset(-1, 0), Target.Offset(-1, 6)).Font.Bold = True
Range(Target.Offset(-1, 0), Target.Offset(-1, 6)).Font.Size = 12
'Range(Target.Offset(-1, 0), Target.Offset(-1, 6)).Font.ColorIndex = 3
'Range(Target.Offset(-1, 0), Target.Offset(-1, 0)) = Date - 1
Set rngSumColor = Find_Farbbereich(Range("D1", Cells(Target.Row - 1, 4)), 37)
If Not rngSumColor Is Nothing Then
Cells(Target.Row - 1, 4).Formula = "=SUM(" & rngSumColor.Address(0) & ")"
Else
If Cells(Target.Row - 1, 4).Interior.ColorIndex = 37 Then _
Cells(Target.Row - 1, 4) = ""
End If
Else
On Error Resume Next ' Bei Fehler weiter machen
If Cells(Target.Row - 1, 4).Interior.ColorIndex = 37 Then _
Cells(Target.Row - 1, 4) = ""
Range(Target.Offset(-1, 0), Target.Offset(-1, 7)).Interior.ColorIndex = xlNone
End If
On Error Resume Next
If Target.Column = 1 And Target "" Then 'nur Spalte A und Zelle nicht leer
Target = DateSerial(Cells(1, 16), Cells(1, 15), Target.Value) 'O1=Monat P1=Jahr
End If
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect([A2:A18000], Target) Is Nothing Then
If Target.Value = Date Then
'Target.Value = x1None
Else
Target.Value = Date
End If
Cancel = True
End If
End Sub
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Me.ScrollArea = "$A$3:$I$5000"
Range("A1:I5000").Columns.AutoFit
Application.ScreenUpdating = True
End Sub
'Sverweis in G
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("G3:G8000").FormulaR1C1 = "=IF(RC6="""","""",VLOOKUP(RC6,Artikeln!R2C1:R49999C5,3))"
End Sub
Du solltest in der Selection_Change-Prozedur die Ereignisse abschalten.
Und
Außerdem finde ich es nicht sehr geschickt, bei jedem Auswahlwechsel 8000 Formeln zu schreiben.
Nochmals Danke & Gruß