Lieber Sdeluxe,

also wirklich prickelnd informativ war auch deine letzte Antwort nicht.

Egal, eine einfache Testumgebung:

Datendatei(en) - Spalte C mit  x bis 5000+/-x Zahlenwerten

ditto  - Spalte B1 mit  1. Kriterium (hier eine Maximalvorgabe)

ditto  - Spalte B2 mit  1. Kriterium (hier eine Minimalvorgabe)

ditto  - Spalte B3 mit  2. Kriterium (hier eine Maximalvorgabe)

ditto  - Spalte B4 mit  2. Kriterium (hier eine Minimalvorgabe)

Aufgabe:

Liste alle Dateien und schreibe die Dateinamen in Spalte A untereinander

dazu die Ergebnisse der MAX Funktion der Zahlenwerte jeder Datei

- und zwar nur innerhalb der Bandbreite Kriterium 1 bzw. 2

jetzt kannste den Code in ein leeres Workbook packen, den Pfad und

die Dateimaske anpassen

Was sich wirklich abspielen soll?

Dazu müsste " Function TestModul2a()" angepasst werden!

ABER, sry - bei deinen Erläuterungen bleibt das für mich "Schleierfahndung"!

Option Explicit

Sub TestModul1()
' ACHTUNG Microsoft Scripting Runtime in VBA-Editor/Extras/Verweise einbinden
'
' - erstelle eine sortierte Liste
' hier Tabelle "Ergebnisse" - Spalte A
'
'****************************************************
' hier die Voreinstellungen - anpassen!
Const LW_START As String = "E:\Temp"   'Startlaufwerk
Const NM_MASKE As String = "ANONYM-??-??-????.xlsx"
'****************************************************
'
Dim oFSO As New FileSystemObject
Dim oFolder As Folder
Dim oFile As File
'
Dim Rng As Range
'
   On Error GoTo TestModul1_Error
   Application.ScreenUpdating = False
'
   With Sheets("Ergebnisse")
      .Activate
      .Cells.Clear
      Set Rng = Cells(1, 1)
      '
      Set oFolder = oFSO.GetFolder(LW_START)
      For Each oFile In oFolder.Files
         If oFile.Name Like NM_MASKE Then
            Rng.Value = LW_START & "\" & oFile.Name
            Set Rng = Rng.Offset(1)
         End If
      Next oFile
      Columns(1).AutoFit
'
   End With
'
   On Error GoTo 0
'
TestModul1_Error:
'------------------------------------------------------------------------------
Select Case Err.Number
   Case Is = 0:   'errorless
      'Liste abarbeiten
      Call TestModul2
   Case Is = 9:   'Table
      Sheets.Add After:=Worksheets(Sheets.Count)
      ActiveSheet.Name = "Ergebnisse"
      Resume
   Case Is = 76:  'FSO
      Call MsgBox("Voreinstellungen Pfad?", vbCritical, "Abbruch")
      '
   Case Else:     'display
      '
End Select
'------------------------------------------------------------------------------
'
Set oFile = Nothing
Set oFolder = Nothing
Set oFSO = Nothing
Application.ScreenUpdating = True
'
End Sub
'
'
Sub TestModul2()
'**********************************************************************************
' ACHTUNG
'**********************************************************************************
' ggf. können Einschränkungen am installierten Office den  OLEDB-Zugriff verhindern
' - hier getestet unter Excel Version 15.0 = Excel 2013
' - Verweise im VBA Editor beachten
' ggf. AccessDatabaseEngine passend zum Windows Betreibmichsystem
' http://www.microsoft.com/de-de/download/details.aspx?id=13255
'**********************************************************************************
'
' - Schleife über die Liste
' - Abfragestring standard
Const SEL_FROM As String = "SELECT * FROM "
' - Objektdeklaration
Dim oConn As Object
Dim oRS As Object
Dim sSQL As String
'
Dim Rng As Range
Dim arrResult() As Variant
Dim x As Long
'
   On Error GoTo TestModul2_Error
'
   With Sheets("Temp")
      .Activate
      Set Rng = Sheets("Ergebnisse").Cells(1, 1)
      '
      Do While Len(Trim(Rng.Value)) > 0
         '
         Set oConn = CreateObject("ADODB.Connection")
         Set oRS = CreateObject("ADODB.Recordset")
         With oConn
            .Provider = "Microsoft.ACE.OLEDB.12.0"
            .ConnectionString = "Data Source=" & Rng.Value & ";" & _
            "Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"""
            .Open
         End With
         'erster Tabellenname
         Set oRS = oConn.OpenSchema(20)
         sSQL = SEL_FROM & Chr(91) & oRS.Fields(2).Value & Chr(93)
         Set oRS = Nothing
         'die Daten
         Set oRS = CreateObject("ADODB.Recordset")
         oRS.Open sSQL, oConn, 3, 1, 1
         If Not oRS.EOF Then
            .Cells.Clear
            .Cells(1, 1).CopyFromRecordset oRS
         End If
         '
         'jetzt die Auswertung
         arrResult = TestModul2a
         For x = LBound(arrResult) To UBound(arrResult)
            Rng.Offset(, x).Value = arrResult(x)
         Next x
         Set Rng = Rng.Offset(1)
      Loop
   End With
'
   On Error GoTo 0
'
TestModul2_Error:
'------------------------------------------------------------------------------
Select Case Err.Number
  Case Is = 0: 'errorless
  Case Is = 9:   'Table
      Sheets.Add After:=Worksheets(Sheets.Count)
      ActiveSheet.Name = "Temp"
      Resume
  Case Else: 'display
      
End Select
'------------------------------------------------------------------------------
End Sub
'
'
Function TestModul2a() As Variant
' - im temporären Arbeitsblatt mit Code die gewünschten Matrixformeln einfügen
' - Ergebnisse in das Hauptarbeitsblatt übertragen
' - aktive Tabelle ist IMMER noch "Temp"
'
' Voreinstellungen (wegen nicht bekannter Anforderungen als einfaches Beispiel):
' Spalte B enthält Zahlenreihen
' Spalte A je einen Maximal/Minimalwert (A1/A2)
' Spalte A je einen Maximal/Minimalwert (A3/A4)
' Regelformel
Const RULE_01 = "=MAX(IF((R[-5000]C:R[-1]C<=R[-5000]C[-1])*(R[-5000]C:R[-1]C>=R[-4999]C[-1]),R[-5000]C:R[-1]C))"
Const RULE_02 = "=MAX(IF((R[-5000]C:R[-1]C<=R[-4998]C[-1])*(R[-5000]C:R[-1]C>=R[-4997]C[-1]),R[-5000]C:R[-1]C))"
'
' hier 2 Regeln, daher
Dim myArr(1 To 2)
'
Dim Rng As Range
Dim lngRows As Long
Dim strFormula As String
Dim strSwap As String
'
Application.Calculation = xlCalculationManual
'
   With Sheets("Temp")
      'Spaltenlänge B
      Set Rng = Range(.Cells(1, 2), .Cells(Rows.Count, 2).End(xlUp))
      lngRows = Rng.Cells.Count
      'Formel Zelle darunter
      Set Rng = Rng.Cells(Rng.Cells.Count).Offset(1)
      'Wertetausch absolut
      strFormula = Replace(RULE_01, "5000", Format(lngRows, "0"))
      'jetzt die Bezüge
      strFormula = Replace(strFormula, "4999", Format(lngRows - 1, "0"))
      Rng.FormulaArray = strFormula
      .Calculate
      myArr(1) = Rng.Value
      'ditto
      Rng.Clear
      strFormula = Replace(RULE_02, "5000", Format(lngRows, "0"))
      strFormula = Replace(strFormula, "4998", Format(lngRows - 2, "0"))
      strFormula = Replace(strFormula, "4997", Format(lngRows - 3, "0"))
      Rng.FormulaArray = strFormula
      myArr(2) = Rng.Value
      .Calculate
   End With
Application.Calculation = xlCalculationAutomatic
TestModul2a = myArr
End Function