Antwort
Anbei meine Lösung zum Problem, mit dem großen Nachteil:
Nur in Excel 2016 nutzbar und nach dem erstellen von 50 Measures wird das Makro immer langsamer!
Sub PPneuMeasure() 'nur in Excel 2016 verwendbar
Dim Mdl As Model
Set Mdl = ActiveWorkbook.Model
Dim tbMdl As ModelTable
Set tbMdl = Mdl.ModelTables("tbl_daten")
Dim lJahr As Long
Dim intMonat, Tag As Integer
Dim strMeasure As String
Dim strMeasureName As String
On Error GoTo Errorhandler
Call Applications_Anfang
lJahr = 2019
intMonat = 1
For Tag = 1 To 100
strMeasure = "CALCULATE(SUM([Anzahl Mitarbeiter]),tbl_Daten[gültig ab]<=DATE(" & lJahr & "," & intMonat & "," & Tag & "),tbl_Daten[gültig bis]>=DATE(" & lJahr & "," & intMonat & "," & Tag & "))"
strMeasureName = Format(DateSerial(lJahr, intMonat, Tag), "dd.mm.yyyy")
Mdl.ModelMeasures.Add strMeasureName, tbMdl, strMeasure, Mdl.ModelFormatDate
Application.StatusBar = Tag
Next Tag
Errorhandler:
Call Applications_Ende
End Sub
___
Public Sub Applications_Anfang()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
.Calculation = xlManual
End With
End Sub
____
Public Sub Applications_Ende()
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
.StatusBar = False
.Calculation = xlAutomatic
End With
End Sub