Optimering af For-sætning

Hej Eksperter

Jeg har nedenstående kode, som jeg vil hører om man ikke kan optimere. Synes det tager lidt lang tid for pc'en at regne. (1-2 sek.)

Application.ScreenUpdating = False

Dim ws_BSimData, ws_Temp, ws_Settings As Worksheet
Dim rngC, rng1 As Range
Dim TempData, WorkingWeek, WorkingYear, TempData_Week, TempData_Days, TempData_Time As Range
Dim TempDataWork(8760, 1), TempWork() As Double
Dim Y, X, Z, S, i As Long

' Temperature calculations
Set ws_BSimData = ActiveWorkbook.Worksheets("BSim-data")
Set ws_Temp = ActiveWorkbook.Worksheets("Results_Temp")
Set ws_Settings = ActiveWorkbook.Worksheets("Settings")

Set TempData = ws_BSimData.Range("BSim_Top")
Set TempData_Days = ws_BSimData.Range("A2:A8761")
Set TempData_Time = ws_BSimData.Range("F2:F8761")
Set TempData_Week = ws_BSimData.Range("B2:B8761")

Set WorkingWeek = ws_Settings.Range("A2:Y9")
Set WorkingYear = ws_Settings.Range("A13:BA14")

S = 0


For Z = 1 To 8760
    For i = 1 To 53
        If WorkingYear(1, i) = TempData_Week(Z, 1) Then
            If WorkingYear(2, i) = "x" Then
                For X = 2 To 8
                    If WorkingWeek(X, 1) = TempData_Days(Z, 1) Then
                        For Y = 2 To 25
                            If WorkingWeek(1, Y) = TempData_Time(Z, 1) Then
                                If WorkingWeek(X, Y) = "x" Then
                                    S = S + 1
                                    TempDataWork(S, 1) = TempData(Z, 1)
                                End If
                            End If
                        Next
                    End If
                Next
            End If
        End If
    Next
Next

S = S + 1
   
ws_Temp.Range("D1:E8761").ClearContents
ws_Temp.Range("D2").Resize(S, 1) = TempDataWork

Er der ikke en måde man kan optimere disse løkker.

Sig endelig til hvis I har brug for noget mere forklaring.