Hallo,

ich habe hier einen Code, der in einer Arbeitsmappe nach einem oder zwei Werten suchen kann.

Alles das was ich wollte funktioniert auch, nur hätte ich jetzt gerne das der Wert auch angezeigt wird

in der (Spalte/Zelle) in der der Wert gefunden worden ist.

hat da jemand eine Idee und könnte mir helfen.

Gruß

Axel

Sub Suchen_und_Anzeigen_neu()
    Dim Meldung         As Byte, Pos        As Byte
    Dim Schleife        As Byte, y          As Byte
    Dim Begriff, Suchen()                   As Variant
    Dim Bereich                             As Range
    Dim n%, x%, xZelle%, yZelle%
    Dim xTabelle$(), Adresse$(), xWorkbook$(), Text$
    Dim arrWkb As Variant, varWkb, wkb As Workbook
    Dim wksAnzeige As Worksheet
    
    
    ' Suchbegriff eingeben
    Begriff = InputBox _
    ("Bitte den zu suchenden Wert eingeben." & vbCrLf & _
     "ENTER ohne Wert = Abbruch", "S U C H M O D U S")
    If Begriff = "" Then Exit Sub
    
    Pos = InStr(Begriff, "+")
    If Pos Then
        ReDim Suchen(2)
        Suchen(1) = Left(Begriff, Pos - 1)
        Suchen(2) = Right(Begriff, Len(Begriff) - Pos)
        Schleife = 2
    Else
        ReDim Suchen(1)
        Suchen(1) = Begriff
        Schleife = 1
    End If
    
    x = 1 'Zähler für gefundene Zellen
    
DateiAuswahl:
    'zu durchsuchende Datei(en) auswählen
    arrWkb = Application.GetOpenFilename( _
            Filefilter:="Excel (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", _
            Title:="Bitte zu durchsuchende Datei(en) auswählen", _
            MultiSelect:=True)
    If Not IsArray(arrWkb) Then Exit Sub
    
    Application.ScreenUpdating = False
    
    ' Eigentlicher Suchvorgang (in allen Tabellenblättern)
    For Each varWkb In arrWkb
        Set wkb = Workbooks.Open(Filename:=varWkb, ReadOnly:=True)
        For y = 1 To Schleife
          For n = 1 To wkb.Sheets.Count
          
          ' Letzte Zelle des Bereiches ermitteln. Diese Zelle wird als Startzelle für
          ' die Suche deffiniert, da Suche nach dieser Zelle, also in erster Zelle
          ' des Bereiches beginnt.
          'Bereich festlegen
            Set Bereich = wkb.Worksheets(n).UsedRange
          
            With wkb.Worksheets(n).Range(Bereich.Address)
              xZelle = .Columns(.Columns.Count).Column
              yZelle = .Rows(.Rows.Count).Row
            End With
            With wkb.Sheets(n).Range(Bereich.Address)
              Set c = .Find(Suchen(y), After:=Cells(yZelle, xZelle), LookIn:=xlValues)
              If Not c Is Nothing Then
                  ErsteAdresse = c.Address
                  Do
                      ReDim Preserve Adresse(x): ReDim Preserve xTabelle(x)
                      ReDim Preserve xWorkbook(x)
                      xWorkbook(x) = wkb.Name
                      xTabelle(x) = wkb.Sheets(n).Name
                      Adresse(x) = c.Address(RowAbsolute:=False, ColumnAbsolute:=False)
                      Set c = .FindNext(c)
                      x = x + 1
                  Loop While Not c Is Nothing And c.Address <> ErsteAdresse
              End If
            End With
          Next n
        Next y
        wkb.Close savechanges:=False
    Next varWkb

    Application.ScreenUpdating = True
    
    If MsgBox("Weitere Dateien nach dem Suchbegriff """ & Begriff _
        & """ durchsuchen?", vbYesNo + vbQuestion, "S U C H M O D U S") = vbYes Then _
        GoTo DateiAuswahl
    
' Die Anzahl der gefundenen Werte ist (x - 1), wenn keiner
' gefunden wurde dann ist x = 1
    Select Case x
    Case 1
        Meldung = MsgBox("Es wurde kein übereinstimmender Wert gefunden", _
        vbOKOnly, "G E F U N D E N E   W E R T E")
        Exit Sub
    Case Else
        Meldung = MsgBox("Es wurden " & (x - 1) & " Übereinstimmungen gefunden.", _
        vbOKOnly, "G E F U N D E N E   W E R T E")
    
        Application.ScreenUpdating = False
        'Tabelle einfügen
        Set wkb = Application.Workbooks.Add(Template:=xlWBATWorksheet)
        Set wksAnzeige = wkb.Worksheets(1)
        On Error Resume Next
        With wksAnzeige
            .Name = "Auswertung"
            .Cells(1, 1) = "Suchbegriff"
            .Cells(1, 2) = Begriff
            .Cells(2, 1) = "Workbook"
            .Cells(2, 2) = "Tabelle"
            .Cells(2, 3) = "Zelle"
            .Cells(3, 1).Select
            ActiveWindow.FreezePanes = True
        
            For n = 1 To x - 1
                .Cells(n + 2, 1) = xWorkbook(n)
                .Cells(n + 2, 2) = xTabelle(n)
                .Cells(n + 2, 3) = Adresse(n)
            Next n
            .Columns.AutoFit
        End With
        Application.ScreenUpdating = True
    End Select

End Sub