Code extrem langsam

Private Sub Chart_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y  _
_
_
As Long)
Dim ElementID As Long, SeriesIndex As Long, PointIndex As Long
Dim s As Series, i As Integer, J As Integer, Form As String
Dim CellX As Range, CellY As Range
Dim wb As Workbook, mafi As Workbook
On Error Resume Next
Set pruefblatt = ThisWorkbook.Sheets("Einzeldat")
If Err.Number  0 Then Exit Sub
On Error GoTo 0
If ThisWorkbook.Sheets("Steuerung").Range("B11") = "Nein" Then Exit Sub
diemappedoheisst = ThisWorkbook.Name
If ActiveWorkbook.Name = diemappedoheisst Then
Set wb = ActiveWorkbook
ActiveChart.GetChartElement x, y, ElementID, SeriesIndex, PointIndex
If ElementID = xlSeries And (SeriesIndex = 1 Or SeriesIndex = 9) Then
Form = ActiveChart.SeriesCollection(SeriesIndex).Formula
i = InStr(1, Form, ",") + 1
J = InStr(i, Form, ",") + 1
Set CellX = Range(Mid$(Form, i, J - i - 1))(PointIndex)
Alter = CellX(1, 1)
Lohn = CellX(1, 5) 'Spalte in Filterblatt (hier "sel") relativ zur Alterspalte
AnzZeilen = WorksheetFunction.Count(wb.Sheets("EINZELDAT").Range("B:B"))
Treffer = 0
For i = 1 To 25
NRF = "@" & wb.Sheets("Steuerung").Range("I24").Offset(i)
If NRF  "" Then
For Z = 1 To AnzZeilen
aktjahr = Year(Now())
Alteri = wb.Sheets("EINZELDAT").Range("O1").Offset(Z)
Lohni = wb.Sheets("EINZELDAT").Range("F1").Offset(Z)
NRFi = "@" & wb.Sheets("EINZELDAT").Range("D1").Offset(Z)
If IsError(NRFi) = False Then
If Alteri = Alter And Lohni = Lohn And NRFi = NRF Then
Treffer = Treffer + 1
Msg_Txt = Msg_Txt & vbLf & "Pers.Nr. " & wb.Sheets("EINZELDAT").Range("A1").Offset(  _
_
_
Z) & ": " & _
" " & wb.Sheets("EINZELDAT").Range("H1").Offset(Z) & ", " & wb.Sheets("EINZELDAT") _
_
_
.Range("I1").Offset(Z) & Chr(10) & _
"OE: " & wb.Sheets("EINZELDAT").Range("K1").Offset(Z) & Chr(10) & _
"Stelle (untergeordnet): " & wb.Sheets("EINZELDAT").Range("J1").Offset(Z) & Chr(   _
_
_
10) & _
"Funktion (übergeordnet): " & wb.Sheets("EINZELDAT").Range("D1").Offset(Z) & Chr(  _
_
_
10) & _
"Geschlecht: " & wb.Sheets("EINZELDAT").Range("C1").Offset(Z)
End If
End If
Next Z
End If
Next i
MsgBox "Total Treffer: " & Treffer & Chr(13) & vbLf & Msg_Txt
End If
End If
End Sub