AW: Nach Werten suchen und anzeigen.
14.05.2014 00:44:07
fcs
Hallo Jan,
hier ein Beispiel, das du ggf. noch an deine Dateien und Verzeichnisse anpassen muss.
Gruß
Franz
Sub Check_in_Quelldatei()
Dim wkb_Q As Workbook, wks_Q As Worksheet, strDateiQ As String
Dim rngSearch As Range, varSearch As Variant, strFehlt As String
Dim wksForm As Worksheet, Zeile_F As Long
Set wksForm = ActiveWorkbook.Worksheets("Formular")
'Name der Quelldatei
strDateiQ = "C:\Users\Public\Test\Quelle.xlsx"
'Quelldatei schreibgeschützt öffnen
Set wkb_Q = Application.Workbooks.Open(Filename:=strDateiQ, ReadOnly:=True)
Set wks_Q = wkb_Q.Worksheets(1)
With wksForm
'Zellen im Formular in Spalte A ab Zeile 2 abarbeiten
For Zeile_F = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
varSearch = .Cells(Zeile_F, 1).Value
If varSearch "" Then
'Suchbegriff in Quelltabelle in Spalte A suchen
Set rngSearch = wks_Q.Columns(1).Find(what:=varSearch, LookIn:=xlValues, _
lookat:=xlWhole)
If rngSearch Is Nothing Then
strFehlt = strFehlt & IIf(strFehlt = "", "", " | ") & varSearch
End If
End If
Next Zeile_F
If strFehlt = "" Then
MsgBox "Alle Werte in Spalte A des Formulars in der Quelltabelle gefunden.", _
vbOKOnly, "Suche nach Werten in Spalte A vom Formularblatt"
Else
MsgBox "Nicht gefunden in [" & wkb_Q.Name & "]" & wks_Q.Name & vbLf & strFehlt, _
vbOKOnly, "Suche nach Werten in Spalte A vom Formularblatt"
End If
wkb_Q.Close savechanges:=False
End With
End Sub