Suchen und extrahieren Sie Daten aus mehreren Excel-Dateien mit der Bedingung

Question

so habe ich meine Excel-Datei (sagen wir test.xlsx) und ich habe mehrere Excel-Dateien (xlsm) in einem Ordner, sie haben die gleiche Struktur (5 Spalten, 60 Reihen, nur die Daten darin sind unterschiedlich), ich will jede Datei nur durch Spalten E und F suchen und wenn ich einen spezifischen Wert (Text) finde, als den ganzen Text in dieser spezifischen Zelle zu meiner Akte (test.xlsx) Wenn der Wert mehrere Male in der gleichen Datei gefunden wird, als den Zellenwert in die nächste Zelle in derselben Zeile in meiner Datei test.xlsx einzufügen und bevor ich zur nächsten Datei gehe, möchte ich den Dateinamen in die Daten einfügen wurde in der gleichen Zeile wie die Daten in der nächsten Zelle gefunden ... als die Suche in die nächste Datei verschoben wird, möchte ich, dass die daraus extrahierten Daten in eine neue Zeile eingefügt werden und so weiter. Ich muss das jeden Monat machen und ich mache das manuell, kannst du mir bitte helfen? Danke.

Answer 1

Zunächst einmal - Ihre Test.xlsx sollte ein xlsm sein, wenn Ihr Code drin ist. Alle anderen Dateien (nur mit Daten) - wenn sie keinen Code haben - sollten stattdessen xlsx sein.

jetzt - versuchen, diesen Code mit den oben genannten Änderungen in einem Modul in Test.xlsm:

Sub openFilesExtractData() 

    Dim folderPath As String, path As String, yourText As String 
    Dim currWbSh As Worksheet 
    Dim i As Long, j As Long, k As Long 

    folderPath = ThisWorkbook.path 

    path = folderPath & "\*.xlsx" 

    Filename = Dir(path) 

    j = ThisWorkbook.Worksheets(1).UsedRange.Rows.count + 1 
    k = 1 

    Do While Filename <> "" 

     If Filename <> ThisWorkbook.Name And Filename <> "" Then 

      Workbooks.Open folderPath & "\" & Filename 

      Set currWbSh = Workbooks(Filename).Worksheets(1) 

      yourText = InputBox("What are you searching for?") 

      For i = 1 To currWbSh.UsedRange.Rows.count 

       Select Case yourText 

        Case currWbSh.Cells(i, 5): 

         ThisWorkbook.Worksheets(1).Cells(j, k) = yourText 
         k = k + 1 

        Case currWbSh.Cells(i, 6): 

         ThisWorkbook.Worksheets(1).Cells(j, k) = yourText 
         k = k + 1 

       End Select 

       If i = currWbSh.UsedRange.Rows.count And k <> 1 Then 

        ThisWorkbook.Worksheets(1).Cells(j, k) = Filename 
        j = j + 1 

       End If 

      Next i 

      Workbooks(Filename).Close False 

     End If 

     Filename = Dir() 
     k = 1 
     j = ThisWorkbook.Worksheets(1).UsedRange.Rows.count + 1 

    Loop 

End Sub 

Diese jede Datei in dem angegebenen Pfad mit einer Datei mit der Endung xlsx öffnen wird, die Suche nach Ihrem Eingabetext IhrText und den gesuchten Text in A1 hinzufügen. Wenn derselbe Wert wieder gefunden wird, schreibt er ihn in die nächste Spalte (gleiche Zeile) und so weiter; Danach wird der Name der geöffneten Datei in die nächste Spalte derselben Zeile gesetzt.