Also so sieht der aus wenn ich versuche mehrere Bedingungen auf NEG und POS zu reduzieren. Leider zeigt er mir nur die Mittelwerte und den NEG MinWert an. Alle anderen Werte sind 0.

Option Explicit
 
Sub berechnen()
Dim name As String
Dim name2 As String
Dim mitwe
Dim max
Dim min
Dim i As Long
Dim bedingungen
Dim pfad As String
Dim suche As String
Dim zeile As Long
Dim summe
Dim formel1
Dim formel2
Dim anzahl As Long
 
bedingungen = Array("", "NEG*", "POS*")
 
pfad = "C:\Users\Simon\Desktop\Master\Forschungsprojekt\Deutschland\Regelleistungsmarkt\MRL"  'hier den Pfad eingeben
If Right(pfad, 1) = "\" Then pfad = Left(pfad, Len(pfad) - 1)
 
Application.ScreenUpdating = False
name = ThisWorkbook.name
 
Workbooks(name).Worksheets(1).Cells(1, 1) = "Dateiname"
For i = 1 To 2
    Workbooks(name).Worksheets(1).Cells(1, 2 + (i - 1) * 3) = "Max " & bedingungen(i) & " [€/MW]"
    Workbooks(name).Worksheets(1).Cells(1, 3 + (i - 1) * 3) = "Min " & bedingungen(i) & " [€/MW]"
    Workbooks(name).Worksheets(1).Cells(1, 4 + (i - 1) * 3) = "Mittwelwert " & bedingungen(i) & " [€/MW]"
Next i
 
zeile = 2
suche = Dir(pfad & "\*.xlsx")   'suche nimmt den Dateinamen auf
   
Do Until suche = ""
 
        If Left(suche, 13) = "ERGEBNISLISTE" Then   'könnte man noch ausbauen
          
            Workbooks.Open pfad & "\" & suche
            name2 = ActiveWorkbook.name
            For i = 1 To 2
                anzahl = Application.WorksheetFunction.CountIf(Workbooks(name2).Worksheets(1).Columns(2), bedingungen(i))
                summe = Application.WorksheetFunction.SumIf(Worksheets(1).Columns(2), bedingungen(i), Worksheets(1).Columns(3))
                mitwe = summe / anzahl
            'Spalte B Bedingungen, Spalte C Werte
                formel1 = "=MAX((B2:B8000=" & Chr(34) & bedingungen(i) & Chr(34) & ")*(C2:C8000))"
                formel2 = "=SVERWEIS(" & Chr(34) & bedingungen(i) & Chr(34) & ";B2:C8000;2;FALSCH)"
                Workbooks(name2).Worksheets(1).Cells(1, 4).FormulaArray = formel1
                max = Worksheets(1).Cells(1, 4).Value
                Workbooks(name2).Worksheets(1).Columns("B:C").Sort Key1:=Workbooks(name2).Worksheets(1).Range("B1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
                Workbooks(name2).Worksheets(1).Cells(1, 5).FormulaLocal = formel2
                min = Worksheets(1).Cells(1, 5).Value
                        
                Workbooks(name).Worksheets(1).Cells(zeile, 4 + (i - 1) * 3) = mitwe
                Workbooks(name).Worksheets(1).Cells(zeile, 3 + (i - 1) * 3) = min
                Workbooks(name).Worksheets(1).Cells(zeile, 2 + (i - 1) * 3) = max
            Next i
            
            Workbooks(name2).Close savechanges:=False
            
            Workbooks(name).Worksheets(1).Cells(zeile, 1) = suche
            zeile = zeile + 1
        End If
   
           
    suche = Dir()
Loop
Workbooks(name).Worksheets(1).Range("A:M").Columns.AutoFit
Workbooks(name).Worksheets(1).Range("A:M").HorizontalAlignment = xlCenter
Application.ScreenUpdating = True
 
End Sub