Thema Datum  Von Nutzer Rating
Antwort
Rot Code tunen
29.11.2018 12:12:25 schrotti
NotSolved

Ansicht des Beitrags:
Von:
schrotti
Datum:
29.11.2018 12:12:25
Views:
778
Rating: Antwort:
  Ja
Thema:
Code tunen

Hallo, ich sitz an einem Datei Backup mit einigen hundert Exceldateien.
Die Dateien haben nicht immer gleich viel Tabellen und ein paar bestimmte Tabellennamen können auch fehlen. Die wurden manchmal vom Sachbearbeiter geschrottet und dann einfach gelöscht.
Aufgabe ist zu trennen, wo sind die Vorgaben Namen noch drin, wo nicht.
Code läuft, aber bei den vielen Dateien brauch ich das Ergebnis viel schneller denn ich muß die Suchbegriffe auch mal ändern.
Wer kann mir was tunen?

Sub Dateienfinden()
Dim Pfad As String, Datei As String
Dim Treffer() As String
Dim x As Long, i As Integer
Dim JA As Long, NEIN As Long
Dim istJa As Boolean

Dim Vorgabe: Vorgabe = Array("Ovary", "Central nervous system")

Cells.ClearContents
Pfad = ThisWorkbook.Path & "\Back"
ChDir Pfad
Datei = Dir("AllExport_T_S_M_Origin_*.xlsx")
  
Application.ScreenUpdating = False
  
Do While Len(Datei) > 0
      Workbooks.Open Datei
      istJa = False
      For x = 2 To Sheets.Count        '1 Summary
         For i = LBound(Vorgabe) To UBound(Vorgabe)
            If Sheets(x).Name = Vorgabe(1) Then
               JA = JA + 1
               istJa = True
               Exit For
            End If
         Next i
         If istJa = True Then Exit For
      Next x
      If istJa = True Then
         ThisWorkbook.Sheets(1).Cells(JA, 1) = ActiveWorkbook.FullName
      Else
         NEIN = NEIN + 1
         ThisWorkbook.Sheets(1).Cells(NEIN, 3) = ActiveWorkbook.FullName
      End If
      ActiveWorkbook.Close
      Datei = Dir
Loop
Application.ScreenUpdating = False
End Sub
 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Code tunen
29.11.2018 12:12:25 schrotti
NotSolved