Als Antwort auf diesen Beitrag
Hallo Bodo,
anbei VBA-Lösung.
Ich habe in jeder Tabelle (Jahre) in Spalte A am Kopf des auszuwertenden Bereichs den Begriff "Auswertung" gesetzt. Dies ist erforderlich, da es kein brauchbares einmaliges Merkmal mehr in den Jahren gab. Das musst du beim Erzeugen eines neuen Tabellenblattes an der Stelle stets setzen.
Des Weiteren habe ich noch eine UDF für die Tabelle ab Gesamt!T5 eingebaut. Somit braucht es keine angepassten Formeln mehr. Es reicht rüber und runterziehen.
Option Explicit
Function TeilnahmeImWMJahr(Jahr As String, rng_Werte As String, Land As String) As Long
TeilnahmeImWMJahr = Application.WorksheetFunction.CountIf(ThisWorkbook.Worksheets(Jahr).Range(rng_Werte), Land)
End Function
Sub Ergebnisse()
Dim wks As Worksheet, arrSum(), rngWerte As Range, rng_Land As Range, i&, j&, k&, l&, iST, iFund
Set rng_Land = Tabelle15.Range("C5:C" & Tabelle15.Cells(Rows.Count, 1).End(xlUp).Row)
ReDim arrSum(1 To rng_Land.Rows.Count, 1 To 15)
For Each wks In ThisWorkbook.Sheets
If IsNumeric(wks.Name) Then
iST = Application.Match("Auswertung", wks.Columns(1), 0)
If Not IsError(iST) Then Set rngWerte = wks.Range("B" & iST & ":J" & wks.Cells(Rows.Count, 2).End(xlUp).Row)
For i = 1 To rng_Land.Count
j = j + 1
iFund = Application.Match(rng_Land.Cells(i, 1), rngWerte.Columns(1), 0)
If Not IsError(iFund) And Not IsError(iST) Then
If wks.Name < "1994" Then
arrSum(j, 1) = arrSum(j, 1) + rngWerte.Cells(iFund, 2)
arrSum(j, 2) = arrSum(j, 2) + rngWerte.Cells(iFund, 3)
arrSum(j, 3) = arrSum(j, 3) + rngWerte.Cells(iFund, 4)
arrSum(j, 4) = arrSum(j, 4) + rngWerte.Cells(iFund, 5)
arrSum(j, 5) = arrSum(j, 5) + rngWerte.Cells(iFund, 6)
arrSum(j, 6) = arrSum(j, 6) + rngWerte.Cells(iFund, 7)
arrSum(j, 7) = arrSum(j, 5) - arrSum(j, 6)
arrSum(j, 8) = arrSum(j, 8) + rngWerte.Cells(iFund, 8)
arrSum(j, 9) = arrSum(j, 9) + rngWerte.Cells(iFund, 9)
Else
arrSum(j, 10) = arrSum(j, 10) + rngWerte.Cells(iFund, 2)
arrSum(j, 11) = arrSum(j, 11) + rngWerte.Cells(iFund, 3)
arrSum(j, 12) = arrSum(j, 12) + rngWerte.Cells(iFund, 4)
arrSum(j, 13) = arrSum(j, 13) + rngWerte.Cells(iFund, 5)
arrSum(j, 5) = arrSum(j, 5) + rngWerte.Cells(iFund, 6)
arrSum(j, 6) = arrSum(j, 6) + rngWerte.Cells(iFund, 7)
arrSum(j, 7) = arrSum(j, 5) - arrSum(j, 6)
End If
End If
Next i
j = 0
k = 0
l = 0
End If
Next
For i = LBound(arrSum) To UBound(arrSum)
arrSum(i, 14) = (arrSum(i, 11) * 3) + arrSum(i, 12)
arrSum(i, 15) = arrSum(i, 8) + arrSum(i, 14)
Next i
Tabelle15.Cells(5, 4).Resize(UBound(arrSum), 15) = arrSum
End Sub
UDF Aufruf in T5 (runter- und rüberziehen):
=TeilnahmeImWMJahr(T$3;"$AA$1:$AA$102";$C5)
https://www.herber.de/bbs/user/180915.xlsm
Gruß Uwe