PDA

Vollständige Version anzeigen : Eine Suche in einer weiteren Excel ausführen lassen


stranded
30.03.2012, 15:47
Hallo zusammen,

vermutlich eine Lapalie, aber ich bekomms nicht hin.
Ich möchte in meiner Datei bei einem Doppelklick auf eine Zelle der Spalte Vertrag eine andere Excel öffnen.
In der just geöffnetten Datei soll Spalte A nach dem Wert durchsucht werden, den ich zuvor in meiner Datei doppelklickte.
Ich möchte die Suche wirklich mittels der üblichen Suchfunktion die man auch mit STRG + F generiert ausführen lassen, da ich im Bedarfsfall so individuell Suchkriterien anpassen kann.




Public Vetragsnummer As String
Public Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If ActiveCell.Column = ActiveSheet.Range("Vertrag").Column Then
vertragsnummer = ActiveCell.Value
dateiaufruf
End If

End Sub
Public Sub dateiaufruf()
Application.ScreenUpdating = False
If ActiveCell.Value > 0 Then
' Vertragsdatenliste aufrufen

On Error GoTo aufhoeren
Workbooks.Open Filename:="\\Server\verzeichnis\Liste.xls"
suchen
Exit Sub
End If
aufhoeren:
On Error Resume Next
dateiname = Application.GetOpenFilename(Title:="Datei auswählen")

If dateiname <> False Then
Workbooks.Open (dateiname)
suchen
End If
End Sub

Public Sub suchen()
Application.ScreenUpdating = True
Columns("A:A").Select
Selection.Find(What:=vertragsnummer, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
End Sub

Was mach ich falsch? Oder besser - wie geht es richtig?
Grüße zum Wochenende
stranded

ChrisVBA
01.04.2012, 20:28
Hallo stranded,

ich habe dir eine Datei beigefügt, in der ich die Struktur deines Makros ein bißchen verändert habe. So sparst du dir auch die globale Variable vertragsnummer.

Damit die mit der normalen Excel-Suche eingestellten Kriterien (wie in ganzer Zelle suchen, in Formeln oder in Werten usw.) erhalten bleiben, ist es wichtig, in VBA nur den Parameter 'What' zu setzen. Dann bleiben die anderen Parameter erhalten.

Viele Grüße!

Christian

stranded
03.04.2012, 08:45
Hallo Christian,

danke für Deine Mithilfe. Dem Ziel bin ich so sehr nahe. Es ist auch praktikabel.
Lediglich der Alternativfall (Vertragsdatei selbst wurde am angegebenen Standort nicht gefunden) führte zu einem Typenunverträglichkeitsfehler.
Habe es aber gelöst wie unten dargestellt.

Dennoch möchte ich aus Interesse gern wissen, ob die ursprüngliche Zielsetzung für das Fester "suchen und ersetzen" (auf dem Reiter Suchen) zu verwenden nicht ebenso möglich ist.
Die verwendete Suche mit dem Find() löst die Aktivierung des Suchbegriffs beim ersten gefunden Treffer über das rg.activate aus und ermöglicht mir nicht das "weitersuchen" wie im Falle einer manuellen Suche über das Suchfenster.
Ist das nicht auch per VBA realisierbar?
Hintergrund ist:
Meine Vertragstabelle enthält den gefunden Wert oft mehrfach, da hier die Vertragshistorie mit Dokumentenverlinkungen zu finden sind und jedes Dokument zum Vertrag eine eigene Zeile hat. Bei Verwendung über das Fenster kann ich ja auf "Weitersuchen" gehen, wenn nicht der erste gefundene Eintrag der gewünschte ist.

'in der Tabelle in der ich den Doppelklick auslöse:
Option Explicit

Public Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If ActiveCell.Column = ActiveSheet.Range("Vertrag").Column Then
dateiaufruf (Target.Value)
End If

End Sub

' In einem Modul:
Option Explicit

Public Sub dateiaufruf(vertragsnummer As String)
Dim dateiname As String
Dim wb As Workbook

Application.ScreenUpdating = False
If ActiveCell.Value > 0 Then
' Vertragsdatenliste aufrufen

On Error GoTo Fehler
Set wb = Workbooks.Open(Filename:="\\server\verzeichnis\vertragsliste.xls")
suchen wb, vertragsnummer
Exit Sub
End If

Fehler:
On Error GoTo 0
dateiname = Application.GetOpenFilename(Title:="Datei auswählen")

If Left(dateiname, 6) <> "Falsch" Then
Set wb = Workbooks.Open(dateiname)
suchen wb, vertragsnummer
End If
End Sub

Public Sub suchen(wb As Workbook, vertragsnummer As String)
Dim rg As Range

Application.ScreenUpdating = True

Set rg = wb.ActiveSheet.Columns("A:A").Find(What:=vertragsnummer)

If Not rg Is Nothing Then
rg.Activate
Else
MsgBox "Die Vertragsnummer " & vertragsnummer & " konnte nicht gefunden werden.", vbCritical, "Vertragsnummer nicht gefunden!"
End If
End Sub




Danke und Grüße
stranded