Zellen externer Excel-Files filtern

[Instant_]

Hallo liebe Community,


ich bin in der Arbeit auf eine neue Challenge getroffen. 

Ich soll für meinen Chef ein Excel-Makro schreiben, was anhand eine Liste mit all den Daten, die man manuell eingibt, erstellt.

Ich veranschauliche es an einem Beispiel.

Ich habe ca. 2000 Excel-Files im selben Ordner.
All diese Excel-Files haben fast das selbe Schema. Tabelle 1 heißt "Informationsblatt". In C2 befindet sich der Gerätename, in C3 die Seriennummer und in C4 die Softwareversion.

Was möchte ich? 

Ein Makro, mit dem ich eingebe "C2 = PA" und "C3 = 0D49" und z.B. "C4 = <4.9". Das heißt, er soll alle Excel-Files, inklusive der Zellen schön in eine Liste packen, die als Gerätename PA, als Seriennummer 0D49 und als Softwareversion kleiner als 4.9 haben. 

Das ist bis jetzt mein Code:

Code:

Option Explicit

Public Sub Files_Read()

Const strSheetQ As String = "Informationsblatt" ' Die Tabelle wird ausgelesen
Const strSheetZ As String = "Tabelle1" ' Die Tabelle in dieser Datei
Const strCellQ1 As String = "C3" ' Die Zelle wird ausgelesen
Const strCellQ2 As String = "C4"
Const strCellQ3 As String = "C5"


   Dim stCalc As Integer
   Dim strDir As String
   Dim objFSO As Object
   Dim objDir As Object
   On Error GoTo Fin
   With Application
       .ScreenUpdating = False
       .AskToUpdateLinks = False
       .EnableEvents = False
       stCalc = .Calculation
       .Calculation = xlCalculationManual
       .DisplayAlerts = False
   End With
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   strDir = ThisWorkbook.Path  ' Datei im gleichen Ordner wie Auswertungsdateien
   Set objDir = objFSO.GetFolder(strDir)
   'dirInfo objDir, "*.xls", True ' Mit Unterordner
   dirInfo objDir, "*.xls"
Fin:
   With Application
       .ScreenUpdating = True
       .AskToUpdateLinks = True
       .EnableEvents = True
       .Calculation = stCalc
       .DisplayAlerts = True
   End With
   Set objDir = Nothing
   Set objFSO = Nothing
End Sub

Public Sub dirInfo(ByVal objCurrentDir As Object, ByVal strName As String, _
   Optional ByVal blnTMP As Boolean = False)
   Dim objWorkbook As Workbook
   Dim strFormula As String
   Dim lngLastRow As Long
   Dim varTMP As Variant
   
   Const strSheetQ As String = "Informationsblatt" ' Die Tabelle wird ausgelesen
Const strSheetZ As String = "Tabelle1" ' Die Tabelle in dieser Datei
Const strCellQ1 As String = "C3" ' Die Zelle wird ausgelesen
Const strCellQ2 As String = "C4"
Const strCellQ3 As String = "C5"

   For Each varTMP In objCurrentDir.Files
       If varTMP.Name Like strName And varTMP.Name <> ThisWorkbook.Name Then
           With ThisWorkbook.Worksheets(strSheetZ)
               lngLastRow = IIf(Len(.Cells(.Rows.Count, 2)), _
                   .Rows.Count, .Cells(.Rows.Count, 2).End(xlUp).Row) + 1
               With .Cells(lngLastRow, 2)
                   .Formula = "='" & Mid(varTMP.Path, 1, _
                       InStrRev(varTMP.Path, "\")) & "[" & _
                       Mid(varTMP.Path, InStrRev(varTMP.Path, "\") + 1) & "]" & _
                       strSheetQ & "'!" & strCellQ1
                   .Offset(0, -1).Value = varTMP.Name
               End With
               With .Cells(lngLastRow, 3)
                   .Formula = "='" & Mid(varTMP.Path, 1, _
                       InStrRev(varTMP.Path, "\")) & "[" & _
                       Mid(varTMP.Path, InStrRev(varTMP.Path, "\") + 1) & "]" & _
                       strSheetQ & "'!" & strCellQ2
               End With
               With .Cells(lngLastRow, 4)
                   .Formula = "='" & Mid(varTMP.Path, 1, _
                       InStrRev(varTMP.Path, "\")) & "[" & _
                       Mid(varTMP.Path, InStrRev(varTMP.Path, "\") + 1) & "]" & _
                       strSheetQ & "'!" & strCellQ3
               End With

               .UsedRange.Value = .UsedRange.Value
           End With
       End If
   Next varTMP
   If blnTMP = True Then
       For Each varTMP In objCurrentDir.SubFolders
           dirInfo varTMP, strName
       Next varTMP
   End If
   Set objWorkbook = Nothing
End Sub

Er liest aber alle Excel-Files aus und schreibt diese auch schön in eine Liste, aber ich möchte sie gleich manuell filtern können. Am besten wäre es, wenn man die gesuchten Daten einfach in eine Zelle oder in ein Textfeld schreibt.

Wisst ihr, was ich meine? Ich bin leider (noch) kein Profi in VBA. :D

Danke an euch!!

Liebe Grüße
Instant

[Dieter63]

Hallo, 

Ich habe ca. 2000 Excel-Files im selben Ordner.

All diese Excel-Files haben fast das selbe Schema.

Was bedeutet fast .

Ansonsten würde ich sagen , das ist was für PowerQuery.

[Instant_]

Hallo, 


Was bedeutet fast .

Ansonsten würde ich sagen , das ist was für PowerQuery.

Fast bedeutet, dass es auch Files gibt die nicht das Schema haben weil sie Vorlagen, also gänzlich andere Dokumente sind. Aber es wäre kein Problem, nur die Files die ausgewertet werden müssen in einem Ordner zu haben. 

Von PowerQuery habe ich schon gehört. Wäre das die beste Lösung? Danke.

LG

[Dieter63]

Hallo, 

die beste Lösung  gibt es nicht

Nach deiner Beschreibung ist das eine Möglichkeit , ich kenne deine Anwendung nicht im Detail.

Du kannst dir ja mal einige Files in einen Testordner kopieren und dann mit  Daten -> Daten abrufen -> aus Ordner ausprobieren

[Gast 123]

Hallo

was passiert beim auflisten, wenn du hinter dem letzten End With und .UsedRange.Value diesen Auswertungs Code einfügst?
Nach meiner Ansicht ist das die einfachste Art die gewünschten Daten auszufiltern.  Indem man die unerwünschten einfach wieder löscht!!

mfg Gast 123

Code:

              End With  ' = .Cells(lngLastRow, 4)
             
              '"C2 = PA" und "C3 = 0D49" und z.B. "C4 = <4.9"
              If .Cells(lngLastRow, 2) = "PA" And .Cells(lngLastRow, 3) = "0D49" Then _
              If .Cells(lngLastRow, 4) < 4.9 Then .Cells(lngLastRow, 2).Resize(1, 3) = Empty
             
              .UsedRange.Value = .UsedRange.Value

---

Nachtrag:  deine Programmierung ist exellent, das ist KEIN Anfaengerwerk!  Da muss ich mich richtig anstrengen da mitzuhalten'
Nach 20 Jahren Excel Programmieren hat man aber bestimmte Erfahrungen gesammt, wie man Probleme am einfachsten lösen könnte ...

[Instant_]

Hallo, 

die beste Lösung  gibt es nicht

Nach deiner Beschreibung ist das eine Möglichkeit , ich kenne deine Anwendung nicht im Detail.

Du kannst dir ja mal einige Files in einen Testordner kopieren und dann mit  Daten -> Daten abrufen -> aus Ordner ausprobieren

Ich werds probieren, der PowerQueryEditor schaut ja recht vielversprechend aus. Danke.

@Gast123

Ich habs ehrlich gesagt nicht selber programmiert, habs mir selber im Internet zusammengesucht. 

Naja...aber ich brauche ja auch eine Art Eingabefeld...und ich möchte ja nach dem Inhalt der Zelle filtern.

[Gast 123]

Hallo

kein Problem, wenn du Variable sein willst dann stelle den Code einfach um!  Lade dir die drei Vergleichswerte VOR der For Bext Schleife in drei Variablen, z.B. VG1-3, und vergleiche  nach der Formel die Zeile ob dieser Wert vorkommt? In welchem Sheet die Vergleichswerte stehen kannst du selbst entscheiden. Und dann aus dem Sheet laden.

mfg Gast 123

Code:

Dim VG1, VG2, VG3 As Variant

  VG1 = Worksheets("aaa").Range("xxx").Value 'Zelle für Vergleichswerte bitte selbst festlegen ....
  VG2 = Worksheets("aaa").Range("yyy").Value
  VG3 = Worksheets("aaa").Range("zzz").Value
           
  For Each varTMP In objCurrentDir.Files
      'Hier der normale Code, nach den letzten End With die Auswertung!
                 
             '"C2 = PA" und "C3 = 0D49" und z.B. "C4 = <4.9"
             If .Cells(lngLastRow, 2) = VG1 And .Cells(lngLastRow, 3) = VG2 Then _
             If .Cells(lngLastRow, 4) < VG3 Then .Cells(lngLastRow, 2).Resize(1, 3) = Empty
           
             .UsedRange.Value = .UsedRange.Value