In mehreren Tabellen suchen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Herbert,
auf die schnelle und nur auf deine beschriebene Situation zugeschnitten.
Forlgenden Code in ein allgemeines Modul.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Function SVERWEIS_3D(Suchkriterium As Variant, Matrix As String, Spaltenindex As Long) As Variant
  Dim rng As Range, objWs As Worksheet, objThisWorkSheet As Worksheet

  Set objThisWorkSheet = Application.ThisCell.Parent

  For Each objWs In objThisWorkSheet.Parent.Worksheets
    If Not objWs Is objThisWorkSheet Then
      Set rng = objWs.Range(Matrix).EntireColumn.Columns(1).Find(What:=Suchkriterium, LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False)
      If Not rng Is Nothing Then
        SVERWEIS_3D = objWs.Range(Matrix).EntireColumn.Cells(rng.Row, Spaltenindex).Value
        Exit For
      End If
    End If
  Next

End Function

in der Tabelle wird die Funktion so angewendet:
Tabelle1

	A	B
46	123	12399
47	456	45699
48	789	78999
49	123	12399

Formeln der Tabelle

Zelle	Formel
B46	=sverweis_3d(A46;"A:E";5)

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4

Gruß Sepp

Hallo Herbert,
"... bin eben ein Laie"
und warum gibst du dann bei Version "Ohne Relevanz" ein?
Nimm diesen Code.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Function SVERWEIS_3D(Suchkriterium As Variant, Matrix As String, Spaltenindex As Long) As Variant
  Dim rng As Range, objWs As Worksheet, objThisWorkSheet As Worksheet

  On Error GoTo ErrExit

  If Spaltenindex > Range(Matrix).Columns.Count Then GoTo ErrExit

  Set objThisWorkSheet = Application.Caller.Parent

  For Each objWs In objThisWorkSheet.Parent.Worksheets
    If Not objWs Is objThisWorkSheet Then
      Set rng = objWs.Range(Matrix).EntireColumn.Columns(1).Find(What:=Suchkriterium, LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False)
      If Not rng Is Nothing Then
        SVERWEIS_3D = objWs.Range(Matrix).EntireColumn.Cells(rng.Row, Spaltenindex).Value
        Exit For
      End If
    End If
  Next

  If SVERWEIS_3D = "" Then SVERWEIS_3D = CVErr(xlErrNA)
  Exit Function

  ErrExit:
  SVERWEIS_3D = CVErr(xlErrRef)
End Function

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

314 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

In mehreren Tabellen suchen

19 Beiträge zum Forumthread Beiträge zu diesem Forumthread

314 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread