Werte festsetzen und Formeln löschen
06.12.2022 16:04:38
Manuel
ich habe folgenden Code, damit in einer bestimmten Zeile ein Wert festgesetzt und die Formel heraus genommen wird. Nun möchte ich das auf weitere Zeilen beziehen. Gibt es ein Möglichkeit das auch auf Tb.Rows 24,28,32 etc. zu automatisieren?
Gruß
Manuel
Hier der Code:
'Der folgende Code setzt die Monatswerte der Deputate in allen Lehrerübersichten auf den Wert ohne Formel
Private Sub Workbook_Open()
Dim Tb As Worksheet, MinDat As Date
Dim Datum As Date, Sp As Integer, RNG As Range
'Erster der Vormonats
Datum = DateSerial(Year(Date), Month(Date) - 1, 1)
For Each Tb In ThisWorkbook.Sheets
Select Case Tb.Name
Case "01_Start", "02_Auswertung_Fachb._Klassen", "03_Verlauf_Deputate", "zzz_Daten", "02.1_Auswertung_Stufen"
'mach nichts
Case Else
Set RNG = Tb.Rows(20)
'Datum vorhanden
Sp = WorksheetFunction.CountIf(RNG, CDbl(Datum))
'in welcher Spalte
If Sp > 0 Then
Sp = WorksheetFunction.Match(CDbl(Datum), RNG, 1)
Else
MinDat = WorksheetFunction.Min(RNG)
If MinDat > Datum Then
'Es gibt keinen Vormonat aber den aktuellen Monat
'Also keinen Fehler ausgeben
'mache nichts
GoTo Weiter
Else
MsgBox "Monatsfehler auf Blatt: " & Tb.Name & vbLf & vbLf & "Bearbeitung gestoppt"
Exit Sub
End If
End If
'Hat Zelle eine Formel?
With Intersect(RNG, Tb.Columns(Sp)).Offset(1, 0) 'Schnittmenge aus Zeile und Spalte
'Wenn Formel, dann als Wert festschreiben
If .HasFormula Then
.Value = .Value
End If
End With
End Select
Weiter:
Next
Sheets(1).Activate
End Sub