Hallo alle VBA Helfer,

ich habe hier nochmal zu einem alten Skript eine Frage, die ich schonmal gestellt habe und eigentlich dachte es hätte mir schon die richtigen Werte geliefert.

In dem folgenden Code will ich aus verschiedenen Datein jeweils den Mittel-, Max- Und Minimalwert berechnen und in eine Tabelle zusammenfassen. Dabei stehen die Bedingungen in Spalte B und die auszuwertenden Daten in Spalte C. Soweit hat alles geklappt.

Jetzt habe ich versucht, Daten aus aus Spalte D, Bedingungen bleiben in B, auszuwerten und jetzt in Tabellenblatt 2 darzustellen. Hierbei treten leider einige Probleme auf. Vielleicht seht ihr den Fehler

Option Explicit
 
Sub berechnenAP()
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\"  '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(2).Cells(1, 2 + (i - 1) * 3) = "Max " & bedingungen(i) & " [€/MW]"
    Workbooks(name).Worksheets(2).Cells(1, 3 + (i - 1) * 3) = "Min " & bedingungen(i) & " [€/MW]"
    Workbooks(name).Worksheets(2).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
      '=ZÄHLENWENN(A1:A7;"pos*")
      anzahl = Application.WorksheetFunction.CountIf(Workbooks(name2).Worksheets(1).Columns(2), bedingungen(i) & "*")
      '=SUMMEWENN(A1:A7;"pos*";B1:B7)
      summe = Application.WorksheetFunction.SumIf(Worksheets(1).Columns(2), bedingungen(i) & "*", Worksheets(1).Columns(4))
      If anzahl = 0 Then
          mitwe = 0
      Else
          mitwe = summe / anzahl
      End If
       
      'Spalte B Bedingungen, Spalte C Werte
      '=SVERWEIS("neg*";A1:B7;2;FALSCH)
       
      formel1 = "=SVERWEIS(" & Chr(34) & bedingungen(i) & "*" & Chr(34) & ";B1:D8000;2;FALSCH)"
       
      Workbooks(name2).Worksheets(1).Columns("B:D").Sort Key1:=Workbooks(name2).Worksheets(1).Range("D1"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
      Workbooks(name2).Worksheets(1).Cells(1, 4).FormulaLocal = formel1
      max = Worksheets(1).Cells(1, 4).Value
      Workbooks(name2).Worksheets(1).Columns("B:D").Sort Key1:=Workbooks(name2).Worksheets(1).Range("D1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
      Workbooks(name2).Worksheets(1).Cells(1, 5).FormulaLocal = formel1
      min = Worksheets(1).Cells(1, 5).Value
              
      Workbooks(name).Worksheets(2).Cells(zeile, 4 + (i - 1) * 3) = mitwe
      Workbooks(name).Worksheets(2).Cells(zeile, 3 + (i - 1) * 3) = min
      Workbooks(name).Worksheets(2).Cells(zeile, 2 + (i - 1) * 3) = max
  Next i


            
            Workbooks(name2).Close savechanges:=False
            
            Workbooks(name).Worksheets(2).Cells(zeile, 1) = suche
            zeile = zeile + 1
        End If
   
           
    suche = Dir()
Loop
Workbooks(name).Worksheets(2).Range("A:M").Columns.AutoFit
Workbooks(name).Worksheets(2).Range("A:M").HorizontalAlignment = xlCenter
Application.ScreenUpdating = True
 
End Sub

Vielen Dank

Gruß Sdeluxe