Code Snippet "VBA Excel"

Excelfunktion Matrixverweis für Webqueries mit veränderlichen Layouts

Private Function funTestString(ByVal strSuchbegriff As String, _
  ByVal strZuDurchsuchen As String, ByVal intMaskierung As Integer)
  
    Select Case intMaskierung
      Case -1 'Am Ende
        If strSuchbegriff = Right(strZuDurchsuchen, Len(strSuchbegriff)) Then
          funTestString = True
        Else
          funTestString = False
        End If
      
      Case 0 'Genau
        If strSuchbegriff = strZuDurchsuchen Then
          funTestString = True
        Else
          funTestString = False
        End If
      
      Case 1 'Am Anfang
        If strSuchbegriff = Left(strZuDurchsuchen, Len(strSuchbegriff)) Then
          funTestString = True
        Else
          funTestString = False
        End If
      
      Case 2 'Irgendwo
        If InStr(strZuDurchsuchen, strSuchbegriff) > 0 Then
          funTestString = True
        Else
          funTestString = False
        End If
      
    End Select
End Function

'Sucht einen Suchbegriff und liefert den Wert aus einer mit Zeilen- und Spaltenoffset
'angegebenen Wert aus Nachbarzelle
'intMaskierung: Suchstring kommt in zu durchsuchendem String vor:
' -1 am Ende
'  0 genau
'  1 am Anfang
'  2 Irgendwo

'intPosition:
'  -1 letztes Vorkommen
'   0 genau 1x, sonst Fehler
'   1 erstes Vorkommen
Public Function funMatrixVerweis(ByVal strSuchbegriff As String, ByVal objMatrix As Range, _
  ByVal lngZeilenoffset As Long, ByVal intSpaltenoffset As Integer, _
  ByVal intMaskierung As Integer, ByVal intPosition As Integer)

  Dim objCell As Range
  Dim varErstesResultat
  Dim varLetztesResultat
  Dim intAnzahlResultate
  
  intAnzahlResultate = 0
  For Each objCell In objMatrix
    If funTestString(strSuchbegriff, objCell.Value, intMaskierung) Then
      intAnzahlResultate = intAnzahlResultate + 1
      If intAnzahlResultate = 1 Then
        varErstesResultat = objCell.Offset(lngZeilenoffset, intSpaltenoffset).Value
      End If
      varLetztesResultat = objCell.Offset(lngZeilenoffset, intSpaltenoffset).Value
    End If
  Next
  
  If intAnzahlResultate > 0 Then
    Select Case intPosition
      Case -1
        funMatrixVerweis = varLetztesResultat
      Case 0
        If intAnzahlResultate = 1 Then
          funMatrixVerweis = varErstesResultat
        Else
          funMatrixVerweis = CVErr(xlErrValue)
        End If
      Case 1
        funMatrixVerweis = varErstesResultat
    End Select
  Else
    funMatrixVerweis = CVErr(xlErrNA)
  End If
End Function