Kniffliges Problem betreffend Suchfunktion?

Re(5): Kniffliges Problem betreffend Suchfunktion?

Thing — Sat, 07 Oct 2006 08:10:45 GMT

Freut micht, dass ich jemandem aus meiner alten Heimat Kärnten helfen konnte.

Noch ein paar Anregungenen zu Deinem Code:

Die MsgBox "Leider Kollege..." würde ich eher nach der For-Schleife machen und dabei dann auf Found=0 abfragen. Ansonsten wird (wenn ich es richtig verstehe) die Meldung inklusive Abbruch immer dann erzeugt, sobald in irgend einer Datei der Suchbegriff nicht gefunden wird (unabhängig davon, ob der Suchbegriff vielleicht in schon zuvor durchsuchten Dateien enthalten war).

Die Zuweisung "Es gibt insgesamt ..." würde ich aus eher prinzipiellen Gründen auch ausserhalb der For-Schleife machen, da sie ja nur einmal durchgeführt werden muss. Ist aber eigentlich kein Problem und von der Laufzeit wirst es auch nicht wirklich bemerken.

Schöne Grüsse aus Wien

Re(4): Kniffliges Problem betreffend Suchfunktion?

SunnyHill — Fri, 06 Oct 2006 05:47:16 GMT

Hallo und vielen Danke für deine Wirklich tolle Hilfe!

Gestern habe ich während der Bürostunden mich selbst nochmals an den Code gemacht, und bin aufgrund deines Erstvorschlages und der resultierenden Anlaufhilfe auf folgendes Ergebnis gekommen:

Sub Dateien_durchsuchen()
Dim Ce As Range

ExcelDateienPfad = "P:\Statistik-Kartei"
SuchBlatt = "Datensätze"
SuchSpalten = "A:F"

SuchBegriff = InputBox("Bitte Suchbegriff eingeben:", "Hallo Kollege " & _
    Application.UserName & "! Wieder mal auf der Suche?")
If SuchBegriff = "" Then Exit Sub

Set Fso = CreateObject("Scripting.FileSystemObject")
Set OXl = CreateObject("Excel.Application")
Set Wb = OXl.Workbooks.Add
Set ShSuchErg = Wb.Sheets(1)

Found = 0
For Each F In Fso.GetFolder(ExcelDateienPfad).Files
  If Right(UCase(F.Name), 4) = ".XLS" Then
    Set WbHelp = OXl.Workbooks.Open(F.Path)

    With WbHelp.Sheets(SuchBlatt).Range(SuchSpalten)
     Set Ce = .Find(SuchBegriff)
     If Ce Is Nothing Then
      Beep
      MsgBox "Leider Kollege " & Application.UserName & "...." + vbCr + vbCr + "Der Suchbegriff <" + sBegriff + "> konnte in keiner gespeicherten Datei gefunden werden!", vbCritical
      Exit Sub
     Else
      FirstHit = Ce.Address
      Do
       Found = Found + 1
       Set Ce = .FindNext(Ce)
       Wb.Sheets(1).Range("A" & (Found + 3)) = Found & ".) " & F & " in Zelle " & Ce.Address
       Wb.Sheets(1).Range("A1") = "Es gibt insgesamt " & Found & " Fundstellen des Suchbegriffes <" & SuchBegriff & ">"
       Wb.Sheets(1).Range("A3") = "Fundstellen:"
      Loop While Not Ce Is Nothing And Ce.Address <> FirstHit
     End If
    End With
   WbHelp.Close
  End If
Next
OXl.Visible = True

End Sub

Grundsätzlich hat dies dann auch so funktioniert wie ich es mir vorgestellt habe, und du es mír auch super erleichtert hast, das Problem zu lösen.

Jedoch richtig abgerundet wurde das Problem erst mit deinem zweiten geposteten Code und dem "ReadOnly"-Hinweis und dem False-Zusatz nach dem .Close Ereignis.

Was haltest du von meinem Ergebnis? Ist zwar sicherlich nicht so schön gelöst wie dein Vorschlag, aber immerhin

Ich möchte mich trotzdem nochmals recht herzlich bei dir bedanken!!!!

lG aus Kärnten

SunnyHill.

Re(4): Kniffliges Problem betreffend Suchfunktion?

SunnyHill — Fri, 06 Oct 2006 05:47:16 GMT

Hallo und vielen Dank für deine wirklich tolle Hilfe!

Gestern habe ich während der Bürostunden mich nochmals an den Code gemacht, und bin aufgrund deines Erstvorschlages und meiner Modifizierung auf folgendes Ergebnis gekommen:

Sub Dateien_durchsuchen()
Dim Ce As Range

ExcelDateienPfad = "P:\Statistik-Kartei"
SuchBlatt = "Datensätze"
SuchSpalten = "A:F"

SuchBegriff = InputBox("Bitte Suchbegriff eingeben:", "Hallo Kollege " & _
    Application.UserName & "! Wieder mal auf der Suche?")
If SuchBegriff = "" Then Exit Sub

Set Fso = CreateObject("Scripting.FileSystemObject")
Set OXl = CreateObject("Excel.Application")
Set Wb = OXl.Workbooks.Add

Found = 0
For Each F In Fso.GetFolder(ExcelDateienPfad).Files
  If Right(UCase(F.Name), 4) = ".XLS" Then
    Set WbHelp = OXl.Workbooks.Open(F.Path)

    With WbHelp.Sheets(SuchBlatt).Range(SuchSpalten)
     Set Ce = .Find(SuchBegriff)
     If Ce Is Nothing Then
      Beep
      MsgBox "Leider Kollege " & Application.UserName & "...." + vbCr + vbCr + "Der Suchbegriff <" + sBegriff + "> konnte in keiner gespeicherten Datei gefunden werden!", vbCritical
      Exit Sub
     Else
      FirstHit = Ce.Address
      Do
       Found = Found + 1
       Set Ce = .FindNext(Ce)
       Wb.Sheets(1).Range("A" & (Found + 3)) = Found & ".) " & F & " in Zelle " & Ce.Address
       Wb.Sheets(1).Range("A1") = "Es gibt insgesamt " & Found & " Fundstellen des Suchbegriffes <" & SuchBegriff & ">"
       Wb.Sheets(1).Range("A3") = "Fundstellen:"
      Loop While Not Ce Is Nothing And Ce.Address <> FirstHit
     End If
    End With
   WbHelp.Close
  End If
Next
OXl.Visible = True

End Sub

Grundsätzlich hat dies dann auch so funktioniert wie ich es mir vorgestellt habe.

Jedoch richtig abgerundet wurde das Problem erst mit deinem zweiten geposteten Code und dem "ReadOnly"-Hinweis und dem False-Zusatz nach dem .Close Ereignis.

Was haltest du von meinem Ergebnis?
Ist zwar sicherlich nicht so schön gelöst wie dein Vorschlag, aber immerhin

Ich möchte mich trotzdem nochmals recht herzlich bei dir bedanken!!!!

lG aus Kärnten

SunnyHill.

Re(4): Kniffliges Problem betreffend Suchfunktion?

SunnyHill — Fri, 06 Oct 2006 05:47:16 GMT

Hallo und vielen Dank für deine wirklich tolle Hilfe!

Gestern habe ich während der Bürostunden mich nochmals an den Code gemacht, und bin aufgrund deines Erstvorschlages und meiner Modifizierung auf folgendes Ergebnis gekommen:

Sub Dateien_durchsuchen()
Dim Ce As Range

ExcelDateienPfad = "P:\Statistik-Kartei"
SuchBlatt = "Datensätze"
SuchSpalten = "A:F"

SuchBegriff = InputBox("Bitte Suchbegriff eingeben:", "Hallo Kollege " & _
    Application.UserName & "! Wieder mal auf der Suche?")
If SuchBegriff = "" Then Exit Sub

Set Fso = CreateObject("Scripting.FileSystemObject")
Set OXl = CreateObject("Excel.Application")
Set Wb = OXl.Workbooks.Add
Set ShSuchErg = Wb.Sheets(1)

Found = 0
For Each F In Fso.GetFolder(ExcelDateienPfad).Files
  If Right(UCase(F.Name), 4) = ".XLS" Then
    Set WbHelp = OXl.Workbooks.Open(F.Path)

    With WbHelp.Sheets(SuchBlatt).Range(SuchSpalten)
     Set Ce = .Find(SuchBegriff)
     If Ce Is Nothing Then
      Beep
      MsgBox "Leider Kollege " & Application.UserName & "...." + vbCr + vbCr + "Der Suchbegriff <" + sBegriff + "> konnte in keiner gespeicherten Datei gefunden werden!", vbCritical
      Exit Sub
     Else
      FirstHit = Ce.Address
      Do
       Found = Found + 1
       Set Ce = .FindNext(Ce)
       Wb.Sheets(1).Range("A" & (Found + 3)) = Found & ".) " & F & " in Zelle " & Ce.Address
       Wb.Sheets(1).Range("A1") = "Es gibt insgesamt " & Found & " Fundstellen des Suchbegriffes <" & SuchBegriff & ">"
       Wb.Sheets(1).Range("A3") = "Fundstellen:"
      Loop While Not Ce Is Nothing And Ce.Address <> FirstHit
     End If
    End With
   WbHelp.Close
  End If
Next
OXl.Visible = True

End Sub

Grundsätzlich hat dies dann auch so funktioniert wie ich es mir vorgestellt habe.

Jedoch richtig abgerundet wurde das Problem erst mit deinem zweiten geposteten Code und dem "ReadOnly"-Hinweis und dem False-Zusatz nach dem .Close Ereignis.

Was haltest du von meinem Ergebnis?
Ist zwar sicherlich nicht so schön gelöst wie dein Vorschlag, aber immerhin

Ich möchte mich trotzdem nochmals recht herzlich bei dir bedanken!!!!

lG aus Kärnten

SunnyHill.

Re(3): Kniffliges Problem betreffend Suchfunktion?

Thing — Thu, 05 Oct 2006 21:46:04 GMT

Okay, war vielleicht doch etwas zu quick&dirty. Ich nehme an, Ihr habt in den Excel-Dateien irgendwelche Start-Makros, die die Sheets zumindest so verändern, dass beim Schliessen der Dateien Abfragen ("Wollen Sie speichern?") kommen. Wenn man diese nicht bestätigt, dann bleiben die Excel-Dateien geladen und die Kollegen bekommen diese Meldungen ("Datei schon geöffnet"). Beim Abmelden fragt Excel dann natürlich noch einmal nach, was mit den geöffneten Dateien nun passieren soll.

Ist natürlich nicht optimal. Daher werden in untenstehender Version die Dateien nun grundsätzlich im ReadOnly-Modus geöffnet und beim Schliessen der Dateien wird explizit auf das Speichern verzichtet (dann sollten auch diese Sicherheitsabfragen nicht mehr kommen).

Die Zeile mit dem obj.Visible habe ich nun etwas vorgezogen, damit man besser sieht was so abläuft. Wenn alles ordnungsgemäss und stabil läuft, kannst Du sie aber wieder runterschieben.

Es wird übrigens nun auch die Anzahl der Treffer pro Datei angezeigt (ich hab das vorher anders verstanden).

'Parameter zum anpassen
ExcelDateienPfad = "C:\Test"
SuchBlatt  = "Tabelle1"
SuchSpalten = "A:CP"

SuchBegriff = InputBox("Suchbegriff","Eingabe")

Set Fso = CreateObject("Scripting.FileSystemObject")
Set OXl = CreateObject("Excel.Application")
Set Wb = OXl.Workbooks.Add
Set ShSuchErg = Wb.Sheets(1)

OXl.Visible = True 'macht Excel sichtbar

AnzahlFundStellen = 0
ZeSuchErg = 2
For Each F In Fso.GetFolder(ExcelDateienPfad).Files
  If Right(UCase(F.Name),4) = ".XLS" Then
    Set WbHelp = OXl.Workbooks.Open(F.Path,,True) 'Öffen im ReadOnly-Modus
    With WbHelp.Sheets(SuchBlatt).Range(SuchSpalten)
      Set Ce = .Find(SuchBegriff)
      If Not Ce Is Nothing Then
        FirstAddress = Ce.Address
        FundstellenInDatei = 0
        Do
          FundstellenInDatei = FundstellenInDatei + 1
          Set Ce = .FindNext(Ce)
        Loop While Not Ce Is Nothing And Ce.Address <> FirstAddress
        ZeSuchErg = ZeSuchErg + 1
        ShSuchErg.Cells(ZeSuchErg,1) = F.Path
        ShSuchErg.Cells(ZeSuchErg,2) = FundstellenInDatei
        AnzahlFundStellen = AnzahlFundStellen + FundstellenInDatei
      End If
    End With
    ShSuchErg.Range("A1") = "Es gibt insgesamt " & AnzahlFundStellen & " Fundstellen des Suchbegriffes <" & SuchBegriff & ">"
    WbHelp.Close False 'Schliessen ohne Speichern
  End If
Next
ShSuchErg.Columns("A").AutoFit 'Spaltenbreite optimieren

Noch ein Tip: Testen würde ich generell nicht "am lebenden Objekt". Am besten erst einmal irgendwo ein Testverzeichnis anlegen und ausprobieren. Wenn es funkt, dann Pfad umstellen auf Echtbetrieb.

Re(3): Kniffliges Problem betreffend Suchfunktion?

Thing — Thu, 05 Oct 2006 21:39:24 GMT
http://forum.geizhals.at/t447213,3692088.html#3692088

Re(3): Kniffliges Problem betreffend Suchfunktion?

Thing — Thu, 05 Oct 2006 21:39:24 GMT
Okay, war vielleicht doch etwas zu quick&dirty. Ich nehme an, Ihr habt in den Excel-Dateien irgendwelche Start-Makros, die die Sheets zumindest so verändern, dass beim Schliessen der Dateien Abfragen ("Wollen Sie speichern?") kommen. Wenn man diese nicht bestätigt, dann bleiben die Excel-Dateien geladen und die Kollegen bekommen diese Meldungen ("Datei schon geöffnet"). Beim Abmelden fragt Excel dann natürlich noch einmal nach, was mit den geöffneten Dateien nun passieren soll.

Ist natürlich nicht optimal. Daher werden in untenstehender Version die Dateien nun grundsätzlich im ReadOnly-Modus geöffnet und beim Schliessen der Dateien wird explizit auf das Speichern verzichtet (dann sollten auch diese Sicherheitsabfragen nicht mehr kommen).

Die Zeile mit dem obj.Visible habe ich nun etwas vorgezogen, damit man besser sieht was so abläuft. Wenn alles ordnungsgemäss und stabil läuft, kannst Du sie aber wieder runterschieben.

Es wird übrigens nun auch die Anzahl der Treffer pro Datei angezeigt (ich hab das vorher anders verstanden).

'Parameter zum anpassen
ExcelDateienPfad = "C:\Test"
SuchBlatt  = "Tabelle1"
SuchSpalten = "A:CP"

SuchBegriff = InputBox("Suchbegriff","Eingabe")

Set Fso = CreateObject("Scripting.FileSystemObject")
Set OXl = CreateObject("Excel.Application")
Set Wb = OXl.Workbooks.Add
Set ShSuchErg = Wb.Sheets(1)

OXl.Visible = True 'macht Excel sichtbar

AnzahlFundStellen = 0
ZeSuchErg = 2
For Each F In Fso.GetFolder(ExcelDateienPfad).Files
  If Right(UCase(F.Name),4) = ".XLS" Then
    Set WbHelp = OXl.Workbooks.Open(F.Path,,True) 'Öffen im ReadOnly-Modus
    With WbHelp.Sheets(SuchBlatt).Range(SuchSpalten)
      Set Ce = .Find(SuchBegriff)
      If Not Ce Is Nothing Then
        FirstAddress = Ce.Address
        FundstellenInDatei = 0
        Do
          FundstellenInDatei = FundstellenInDatei + 1
          Set Ce = .FindNext(Ce)
        Loop While Not Ce Is Nothing And Ce.Address <> FirstAddress
        ZeSuchErg = ZeSuchErg + 1
        ShSuchErg.Cells(ZeSuchErg,1) = F.Path
        ShSuchErg.Cells(ZeSuchErg,2) = FundstellenInDatei
        AnzahlFundStellen = AnzahlFundStellen + FundstellenInDatei
      End If
    End With
    ShSuchErg.Range("A1") = "Es gibt insgesamt " & AnzahlFundStellen & " Fundstellen des Suchbegriffes <" & SuchBegriff & ">"
    WbHelp.Close False 'Schliessen ohne Speichern
  End If
Next
ShSuchErg.Columns("A").AutoFit 'Spaltenbreite optimieren

Noch ein Tip: Testen würde ich generell nicht "am lebenden Objekt". Am besten erst einmal irgendwo ein Testverzeichnis anlegen und ausprobieren. Wenn es funkt, dann Pfad umstellen auf Echtbetrieb.

Re(2): Kniffliges Problem betreffend Suchfunktion?

SunnyHill — Thu, 05 Oct 2006 06:00:46 GMT
Hallo und vorerst einmal Danke für die Hilfe!

Grunsätzlich funktioniert dein Code so, wie ich es mir vorgestellt habe.

Jedoch musste ich feststellen, dass der Code pro durchsuchter Datei immer nur eine Fundstelle anzeigt, obwohl in der Datei zB fünf Treffer wären. Nach der ersten Fundstelle in der Datei wird diese Datei im Hintergrund auch nicht geschlossen, und wird auch schon die zweit Datei geöffnet, durchsucht, im Hintergrund nicht geschlossen, usw.

Eine eingefügte Do while Schleife brachte auch nicht den gewünschten Erfolg??

Als ich nach einigen Tests von einem Kollegen mitgeteilt bekommen habe, dass er eine der zuvor per Code durchsuchten Dateien öffnen wollte, bekam er den Hinweis "Datei geöffnet von xx - Sicherungskopie ... ".

Danach habe ich mich (vom Intranet) abgemeldet, und bekam dann ständig die Excel-Abrage, ob ich die geöffneten Dateien (s.o.) speichern möchte. Danach gings auch wieder für den/die Kollegen.

Was habe ich falsch gemacht?

Nochmals Danke für deine/eure Hilfe!

SunnyHill.

Re(2): Kniffliges Problem betreffend Suchfunktion?

RevX — Sat, 30 Sep 2006 20:00:42 GMT
Wieso? Ist das eine Droge?

Re(2): Kniffliges Problem betreffend Suchfunktion?

SunnyHill — Sat, 30 Sep 2006 10:29:00 GMT
Thx!!!!

Werde kommende Woche dies gleich mal ausprobieren!
Schaut vielversprechend aus...
Leider kannte ich (bis dato ) den Fso und OXl Part deines Codes nicht, weshalb ich mein Problem via VBA selbst nicht lösen konnte....

Vielen Dank.

Re: Kniffliges Problem betreffend Suchfunktion?

Schokokipfal — Fri, 29 Sep 2006 04:40:59 GMT
DMS ist das Zauberwort

Re: Kniffliges Problem betreffend Suchfunktion?

Thing — Thu, 28 Sep 2006 22:24:44 GMT
Vielleicht hilft Dir folgendes VB-Skript. Die Excel-Dateien aus dem Verzeichnis C:\test werden im Hintergrund und damit unsichtbar geöffnet und durchsucht. Am Schluss wird das Ergebnis sichtbar gemacht. Je nach Menge und Grösse der Dateien kann das natürlich manchmal etwas dauern.

'Parameter zum anpassen
ExcelDateienPfad = "C:\Test"
SuchBlatt  = "Tabelle1"
SuchSpalten = "A:CP"

SuchBegriff = InputBox("Suchbegriff","Eingabe")

Set Fso = CreateObject("Scripting.FileSystemObject")
Set OXl = CreateObject("Excel.Application")
Set Wb = OXl.Workbooks.Add

Found = 0
For Each F In Fso.GetFolder(ExcelDateienPfad).Files
  If Right(UCase(F.Name),4) = ".XLS" Then
    Set WbHelp = OXl.Workbooks.Open(F.Path)
    Set Ce = WbHelp.Sheets(SuchBlatt).Range(SuchSpalten).Find(SuchBegriff)
    If Not Ce Is Nothing Then
      Found = Found + 1
      Wb.Sheets(1).Range("A" & (Found+2)) = Found & ") " & F.Path & " in Zelle " & Ce.Address
    End If
    Wb.Sheets(1).Range("A1") = "Es gibt insgesamt " & Found & " Fundstellen des Suchbegriffes <" & SuchBegriff & ">"
    WbHelp.Close
  End If
Next
OXl.Visible = True

Btw: Unerfahrenen Benutzern wöre imho aber trotzdem wesentlich mehr geholfen, wenn sie die grundlegenden Windows-Boardmittel (in diesem Fall die ganz normale Windows-Suche) erlernen würden. Ist ja nicht soo schwer und man kann dieses Wissen dann natürlich auch vielen anderen Situationen anwenden.

Re(2): Kniffliges Problem betreffend Suchfunktion?

SunnyHill — Thu, 28 Sep 2006 17:36:38 GMT
Ich habe noch nie etwas mit einer Datenbank gemacht
Reicht dazu Access aus, bzw. kann ich als Accessneuling eine Datenbank ohne weiters erstellen?

In Hinblick auf VBA-Proggen bin ich nicht ganz unerfahren, aber ob ich eine solche benötigte Abfrage schaffe.....

Vielleicht könnt ihr mir helfen?

thx, SunnyHill.

Re: Kniffliges Problem betreffend Suchfunktion?

mike222 — Thu, 28 Sep 2006 15:53:42 GMT
Aus meiner Sicht sieht das so aus, als ob man über einen Import in eine Datenbank nachdenken sollte. Du hast scheinbar gleichartige Daten über mehrere Excel-Dateien und mehrere Sheets verstreut.
Importiere die Daten in eine Datenbank, dann kannst Du bei Bedarf aus allen möglichen Applikationen heraus darauf zugreifen.

Wenn das nicht geht, dann könntest Du Dir ein VBA-Progrämmchen in Excel schreiben, welches ein Excel nach dem anderen aufmacht und nach Deinen Daten sucht.

Kniffliges Problem betreffend Suchfunktion?

SunnyHill — Wed, 27 Sep 2006 15:19:19 GMT
Hallo!

Folgendes Problem:

Ich habe in einem Verzeichnis mehrere Excel-Dateien, welche aus mehreren Tabellenblättern bestehen.

Gibt es eine Möglichkeit, mit einer externen Suchroutine (Excel, Word, Batchdatei,...?) dieses Verzeichnis nach dem eingegeben Suchbegriff durchsuchen zu lassen, und alle Fundstellen in einer neuen Tabelle anzuzeigen??? Durchsucht sollen zwar alle vorhandenen Dateien werden, jedoch pro Datei nur ein immer gleich benanntest Tabellenblatt mit den Spalten A-CP.

Also wenn ich in die Suchroutine zB "Hannes" eingeben, listet das Programm alle Fundstellen im Suchverzeichnis in etwa so auf:

Es gibt insgesamt "xx" Fundstellen des Suchbegriffes "Suchbegriff".

1) Dateiname 1
2) Dateiname 1
3) Dateiname 3
4) Dateiname 6
...

Da diese Suchfunktion ua von noch unerfahreren PC-Nutzern benötigt wird, ersuche ich nicht um Lösungsvorschläge ala "Windows-Suchfunktion"

Danke,

SunnyHill.