Zum Inhalt springen

Empfohlene Beiträge

Geschrieben

Suche ein Tool welches folgenden Funktionen bereitstellen sollte:

-Tool, das *.xls eines Systemes nach bestimmten Mustern durchgräbt und die in eine Ausgabe(datei) schreibt in welchen XLS diese Muster enthalten waren.

-Tool, das nach bestimmte Muster durch andere ersetzt.

Gibt es so was oder ähnliches

  • 4 Wochen später...
Geschrieben

Hi!

Wenn ich Dich richtig verstanden habe, willst Du in allen Arbeitsmappen Deines Systems nach z.B. einem Suchwort suchen, oder??

Das ganze geht unter VBA und zwar mit Hilfe des FileSystemObjects!

Dafür im VBA-Editor unter Excel in Extras->Verweise die Microsoft Scripting Runtime aktivieren, falls noch nicht geschehen!

Hab mich mal 'n bissel hingesetzt und was altes von mir umgeschrieben!

Sag Bescheid, ob es das ist, was Du wolltest!


Sub suchemuster()

Dim fso As New Scripting.FileSystemObject

Dim rootfld As Scripting.Folder

Dim msg As String

'Hier den "Aufsetzpunkt angeben"

Set rootfld = fso.GetFolder("C:\eigene dateien")

'Starte Rekursion

suchefileinfolder rootfld

MsgBox "Fertig!"

End Sub



Sub suchefileinfolder(rootfld As Folder)

Dim fso As New Scripting.FileSystemObject

Dim fld As Scripting.Folder

Dim fil As Scripting.file

Dim actwrk As Workbook

Dim actsht As Worksheet

Dim txtfile As Scripting.TextStream

Dim suchwort As String


'Hier das Suchwort anpassen


suchwort = "EUR"


For Each fld In rootfld.SubFolders

    'Rekursiv alle Verzeichnisse mit Unterverzeichnissen durcharbeiten

    'Hätte man auch Iterativ schreiben können, aber ich liebe Rekursive Prozeduren :-)

    suchefileinfolder fld

Next

'Postrekursiver Teil

'TextFile für die Ergebniss

'Könnte man auch als Excel-Tabelle machen, war mir aber zuviel arbeit

'Achtung! Die Textdatei wird nicht gelöscht!!! Das heisst, evtl. bleiben alte Ergebnisse stehen!

Set txtfile = fso.OpenTextFile("C:\ergebnis.txt", ForAppending, True)

For Each fil In rootfld.Files

    'Wenn Excel-Tabelle

    If Right(fil.Name, 4) = ".xls" Then

        'öffnen

        Set actwrk = Workbooks.Open(fil.Path)

        'Für jedes Tabellenblatt in der Mappe

        For Each actsht In actwrk.Sheets

            If Not actsht.UsedRange.Find(suchwort) Is Nothing Then

                'Wenn wenigstens einer(!) gefunden wurde, dann schreibe

                'in die Ergebnisdatei und...

                txtfile.Write fil.Path & vbCrLf

                'beende die For-Schleife

                Exit For

            End If

        Next

        'Arbeitsmappe schliessen (ohne speichern) und

        'Objekte freigeben

        actwrk.Close xlDoNotSaveChanges

        Set actwrk = Nothing

        Set actsht = Nothing

    End If

Next

'Textdatei schliessen

txtfile.Close

Set txtfile = Nothing

End Sub

Viel Spass damit,

Red Bull

Geschrieben

Jaaaaa, vielen Dank !!! :D

Bringt mich meinem Ziel schon mal näher.

Mein Problem ist das ein ganz schöner Haufen von xls Files durchsucht werden muss, und dann "Suchen->ersetzen" like, das gefundene durch einen neuen wert ersetzt werden muss.

Danke noch mal !!!

Erstelle ein Benutzerkonto oder melde Dich an, um zu kommentieren

Du musst ein Benutzerkonto haben, um einen Kommentar verfassen zu können

Benutzerkonto erstellen

Neues Benutzerkonto für unsere Community erstellen. Es ist einfach!

Neues Benutzerkonto erstellen

Anmelden

Du hast bereits ein Benutzerkonto? Melde Dich hier an.

Jetzt anmelden

Fachinformatiker.de, 2024 by SE Internet Services

fidelogo_small.png

Schicke uns eine Nachricht!

Fachinformatiker.de ist die größte IT-Community
rund um Ausbildung, Job, Weiterbildung für IT-Fachkräfte.

Fachinformatiker.de App

Download on the App Store
Get it on Google Play

Kontakt

Hier werben?
Oder sende eine E-Mail an

Social media u. feeds

Jobboard für Fachinformatiker und IT-Fachkräfte

×
×
  • Neu erstellen...