Kniffliges Problem betreffend Suchfunktion?
Geizhals » Forum » Programmierung » Kniffliges Problem betreffend Suchfunktion? (15 Beiträge, 295 Mal gelesen) Top-100 | Fresh-100
Du bist nicht angemeldet. [ Login/Registrieren ]
.
Re: Kniffliges Problem betreffend Suchfunktion?
29.09.2006, 00:24:44
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.


Antworten PM Übersicht Chronologisch Zum Vorgänger
 
Melden nicht möglich
...
Re(3): Kniffliges Problem betreffend Suchfunktion?
05.10.2006, 23:46:04
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.


Antworten PM Übersicht Chronologisch Zum Vorgänger
 
Melden nicht möglich
....
Re(4): Kniffliges Problem betreffend Suchfunktion?
06.10.2006, 07:47:16
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.

06.10.2006, 10:02 Uhr - Editiert von SunnyHill, alte Version: hier
Antworten PM Übersicht Chronologisch Zum Vorgänger
 
Melden nicht möglich
 

Dieses Forum ist eine frei zugängliche Diskussionsplattform.
Der Betreiber übernimmt keine Verantwortung für den Inhalt der Beiträge und behält sich das Recht vor, Beiträge mit rechtswidrigem oder anstößigem Inhalt zu löschen.
Datenschutzerklärung