Sub AktualisiereUndBerechneAlles()



    ' Deklaration der Arbeitsblätter

    Dim wsNV As Worksheet

    Dim wsPunkte As Worksheet

    Dim letzteZeileD As Long, letzteZeileM As Long, letzteZeileI As Long

    Dim startZeile As Long

    Dim aktualisieren As Boolean

    Dim abfragen As Variant

    Dim datenN As Variant, datenQ As Variant, datenM As Variant, datenP As Variant

    Dim fehlendeN As String, fehlendeQ As String

    Dim uniqueN As Object, uniqueQ As Object



    ' Konstanten und Startwerte

    startZeile = 253

    Set wsNV = ThisWorkbook.Worksheets("nv")

    Set wsPunkte = ThisWorkbook.Worksheets("Punkte")

    Set wsTabelle1 = ThisWorkbook.Worksheets("Tabelle1")

    



    ' Benutzerabfrage: Soll das vollständige Update erfolgen?

    If MsgBox("Sollen alle Abfragen und die Formeln in den Spalten N, O, Q und R aktualisiert werden?", _

              vbYesNo + vbQuestion, "Aktion wählen") = vbYes Then

        aktualisieren = True

        abfragen = Array("Filme1", "Leute1", "U_250", "jüngste")

    Else

        aktualisieren = False

        abfragen = Array("U_250", "jüngste")

    End If



    ' Optimierung: Bildschirmaktualisierung und Berechnung ausschalten

    Application.ScreenUpdating = False

    Application.Calculation = xlCalculationManual

    Application.EnableEvents = False



    ' **Abfragen aktualisieren**

    Dim i As Integer

    For i = LBound(abfragen) To UBound(abfragen)

        wsNV.ListObjects(abfragen(i)).QueryTable.Refresh BackgroundQuery:=False

    Next i



    ' **Letzte Zeilen in wichtigen Spalten berechnen**

    letzteZeileD = wsNV.Cells(wsNV.Rows.Count, "D").End(xlUp).Row

    letzteZeileM = wsNV.Cells(wsNV.Rows.Count, "M").End(xlUp).Row

    letzteZeileI = wsNV.Cells(wsNV.Rows.Count, "I").End(xlUp).Row



    ' **Formeln in Spalten N, O, Q, R einfügen, wenn vollständige Aktualisierung gewünscht**

    If aktualisieren Then

    

        ' **Berechnungen und Anpassungen in Tabelle1**

            anzahlSeitenD = Application.WorksheetFunction.Ceiling((letzteZeileD - 253) / 250, 1)

            wsTabelle1.Range("J6").Value = "https://www.imdb.com/list/ls548888454/edit-larger?sort=list_order,asc&page=" & anzahlSeitenD

    

            anzahlSeitenI = Application.WorksheetFunction.Ceiling((letzteZeileI - 253) / 250, 1)

            wsTabelle1.Range("J7").Value = "https://www.imdb.com/list/ls590005043/edit-larger?sort=list_order,asc&page=" & anzahlSeitenI

            

        ' Formeln für Spalten N, O, Q, R

        wsNV.Range("N" & startZeile & ":N" & letzteZeileM).FormulaLocal = _

            "=""'"" & XVERWEIS(M" & startZeile & ";$D$254:$D$" & letzteZeileD & ";$E$254:$E$" & letzteZeileD & ";"""";0;1)"

        wsNV.Range("O" & startZeile & ":O" & letzteZeileM).FormulaLocal = _

            "=WENN(XVERWEIS(M" & startZeile & ";$D$254:$D$" & letzteZeileD & ";$G$254:$G$" & letzteZeileD & ";"""";0;1)=0;"""";XVERWEIS(M" & startZeile & ";$D$254:$D$" & letzteZeileD & ";$G$254:$G$" & letzteZeileD & ";"""";0;1))"

        wsNV.Range("Q" & startZeile & ":Q" & letzteZeileM).FormulaLocal = _

            "=XVERWEIS(P" & startZeile & ";$I$254:$I$" & letzteZeileI & ";$J$254:$J$" & letzteZeileI & ";"""";0;1)"

        wsNV.Range("R" & startZeile & ":R" & letzteZeileM).FormulaLocal = _

            "=WENN(XVERWEIS(P" & startZeile & ";$I$254:$I$" & letzteZeileI & ";$K$254:$K$" & letzteZeileI & ";"""";0;1)=0;"""";XVERWEIS(P" & startZeile & ";$I$254:$I$" & letzteZeileI & ";$K$254:$K$" & letzteZeileI & ";"""";0;1))"



        ' Werte fixieren

        wsNV.Range("N253:R" & letzteZeileM).Value = wsNV.Range("N253:R" & letzteZeileM).Value



        ' **Bereich sortieren**

        With wsNV.Sort

            .SortFields.Clear

            .SortFields.Add key:=wsNV.Range("O" & startZeile & ":O" & letzteZeileM), Order:=xlDescending

            .SortFields.Add key:=wsNV.Range("R" & startZeile & ":R" & letzteZeileM), Order:=xlDescending

            .SetRange wsNV.Range("M" & startZeile & ":R" & letzteZeileM)

            .Header = xlNo

            .Apply

        End With

    End If



    ' **Prüfung auf leere Zellen in Spalten N und Q**

    datenN = wsNV.Range("N" & startZeile & ":N" & letzteZeileM).Value

    datenQ = wsNV.Range("Q" & startZeile & ":Q" & letzteZeileM).Value

    datenM = wsNV.Range("M" & startZeile & ":M" & letzteZeileM).Value

    datenP = wsNV.Range("P" & startZeile & ":P" & letzteZeileM).Value



    ' Dictionaries für einzigartige Werte

    Set uniqueN = CreateObject("Scripting.Dictionary")

    Set uniqueQ = CreateObject("Scripting.Dictionary")



    Dim j As Long

    For j = 1 To UBound(datenN, 1)

        If IsEmpty(datenN(j, 1)) Then uniqueN(datenM(j, 1)) = True

        If IsEmpty(datenQ(j, 1)) Then uniqueQ(datenP(j, 1)) = True

    Next j



    If uniqueN.Count > 0 Then fehlendeN = Join(uniqueN.Keys, vbNewLine)

    If uniqueQ.Count > 0 Then fehlendeQ = Join(uniqueQ.Keys, vbNewLine)



    ' Formeln für X und AC berechnen

    With wsNV

        .Range("X254:X503").FormulaLocal = "=ZÄHLENWENN(Z$254:Z$503;U254)"

        .Range("AC254:AC503").FormulaLocal = "=ZÄHLENWENN(U$254:U$503;Z254)"

        .Range("X254:AC503").Value = .Range("X254:AC503").Value

    End With



    ' Formeln und Berechnungen im Blatt Punkte

    With wsPunkte

        .Range("B1:B250").FormulaLocal = "=XVERWEIS(A1;NV!Z$254:Z$503;NV!AA$254:AA$503;"""";0;1)"

        .Range("C1:C250").FormulaLocal = "=XVERWEIS(A1;NV!Z$254:Z$503;NV!AB$254:AB$503;"""";0;1)"

        .Range("D1:D250").FormulaLocal = "=WENN(RANG.GLEICH(C1;C$1:C$250;0)<31;RANG.GLEICH(C1;C$1:C$250;0);"""")"

        .Range("E1:E250").FormulaLocal = "=251*ANZAHL2(H1:BG1)-SUMME(H1:BG1)"

        .Range("F1:F250").FormulaLocal = "=RANG.GLEICH(E1;E$1:E$250;0)"

        .Range("G1:G250").FormulaLocal = "=MIN(H1:BG1)"

        .Range("B1:G250").Value = .Range("B1:G250").Value



        With .Sort

            .SortFields.Clear

            .SortFields.Add key:=wsPunkte.Range("F1:F250"), Order:=xlAscending

            .SetRange wsPunkte.Range("A1:BG250")

            .Header = xlNo

            .Apply

        End With

    End With



    ' Bildschirmaktualisierung wieder aktivieren

    Application.EnableEvents = True

    Application.Calculation = xlCalculationAutomatic

    Application.ScreenUpdating = True



    ' Abschlussnachricht

    Dim nachricht As String

    nachricht = "Daten und Formeln wurden erfolgreich aktualisiert!"

    If fehlendeN <> "" Then

        nachricht = nachricht & vbNewLine & "Leere Zellen in Spalte N, Werte aus M:" & vbNewLine & fehlendeN

    End If

    If fehlendeQ <> "" Then

        nachricht = nachricht & vbNewLine & "Leere Zellen in Spalte Q, Werte aus P:" & vbNewLine & fehlendeQ

    End If

    MsgBox nachricht, vbInformation



End Sub