suchen in geschlossenen dateien
07.04.2004 23:41:58
tim
ich habe den folgenden sehr guten code von nepumuk erhalten. er funzt genau so wie ich es mir vorgestellt habe. trotzdem habe ich noch ein problem:
mit diesem code können keine gefilterten daten gefunden werden. d.h. mit dem 'autofilter' visuell wegspedierte daten werden nicht durchsucht.
kann mir jemand helfen, damit auch diese daten durchsucht werden (anm.: dateien werden optisch nicht geöffnet und so soll es auch bleiben)
vielen dank
tim
Sub suchen()
Dim intIndex As Integer, intZeile1 As Integer, intZeile2 As Integer
Dim strDateiname As String
Dim varSuchbegriff As Variant
Dim myRange As Range
Dim myWorksheet As Worksheet
varSuchbegriff = Application.InputBox("Bitte den Suchbegriff eingeben.", "Eigabe")
If varSuchbegriff = False Or Trim(varSuchbegriff) = "" Then Exit Sub
Set myWorksheet = ThisWorkbook.Worksheets("suchen")
myWorksheet.Cells.ClearContents
Application.ScreenUpdating = False
For intIndex = 1 To 2
strDateiname = "test" & Choose(intIndex, "1", "2") & ".xls"
GetObject "C:\datenbank\" & strDateiname
With Workbooks(strDateiname).Worksheets(Choose(intIndex, "artikel", "beschreibung"))
For intZeile1 = 2 To 500
Set myRange = .Range(.Cells(intZeile1, 1), .Cells(intZeile1, 13)).Find(What:=varSuchbegriff, LookIn:=xlValues, LookAt:=xlPart)
If Not myRange Is Nothing Then
intZeile2 = intZeile2 + 1
myWorksheet.Range(myWorksheet.Cells(intZeile2, 1), myWorksheet.Cells(intZeile2, 13)) = .Range(.Cells(myRange.Row, 1), .Cells(myRange.Row, 13)).Value
End If
Next
End With
Workbooks(strDateiname).Close SaveChanges:=False
Next
Set myRange = Nothing
Set myWorksheet = Nothing
Application.ScreenUpdating = True
End Sub