'---------------------------------------------------------------------------------------
' Procedure : CercaVert
' Author    : Scossa
' Date      : 25/03/2015
' Purpose   : Ricerca sWath nel range Rng e restituisce il
'             valore della cella spostata lCol rispetto alla
'             cella dove il valore è stato trovato.
'---------------------------------------------------------------------------------------
'
Public Function CercaVert( _
  ByVal sWath As String, _
  ByRef rng As Range, _
  ByVal lCol As Long, _
  Optional ByVal bPart As Boolean = False) As Variant


  Dim rFound As Range
  
  Set rFound = rng.Find(sWath, _
      LookAt:=IIf(bPart, xlPart, xlWhole), _
      SearchDirection:=xlNext)
  If Not rFound Is Nothing Then
      CercaVert = rFound.Offset(, lCol).Value
  Else
      CercaVert = CVErr(Excel.xlErrNA)
  End If

End Function

=SE.ERRORE(CERCA.VERT($H$2;SE(RIF.COLONNA(SCARTO($A$1;1;0;CONTA.VALORI(A:A)-1;2))=1;SCARTO($A$1;0;-1+CONFRONTA($H$1;$A$1:$F$1;0);CONTA.VALORI(A:A);1);SCARTO($A$1;0;-1+CONFRONTA($I$1;$A$1:$F$1;0);CONTA.VALORI(A:A);1));2;FALSO);"Verifica Dati di Input")

Public Function CercaVert( _
  ByVal sWath As String, _
  ByRef rng As Range, _
  ByVal lCol As Long, _
  Optional ByVal bPart As Boolean = False) As Variant

'---------------------------------------------------------------------------------------
' Procedure : CercaVert
' Author    : Scossa
' Date      : 25/03/2015
' Purpose   : Ricerca sWath nel range Rng e restituisce il
'             valore della cella spostata lCol rispetto alla
'             cella dove il valore è stato trovato.
'---------------------------------------------------------------------------------------
'
Public Function CercaVert( _
  ByVal sWath As String, _
  ByRef rng As Range, _
  ByVal lCol As Long, _
  Optional ByVal bPart As Boolean = True) As Variant

  Application.Volatile
  Dim rFound As Range
  
  Set rFound = rng.Find(sWath, _
      LookAt:=IIf(bPart, xlPart, xlWhole), _
      SearchDirection:=xlNext)
  If Not rFound Is Nothing Then
      CercaVert = rFound.Offset(, lCol).Value
  Else
      CercaVert = CVErr(Excel.xlErrNA)
  End If

End Function

'Formula:
=SE($H$2="";"";INDICE(D$2:D$6;CONFRONTA($H$2;$F$2:$F$6;0)))

'VBA
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$H$2" Then
        Cells(2, 9).FormulaLocal = "=INDICE(D$2:D$6;CONFRONTA($H$2;$F$2:$F$6;0))"
        Cells(2, 9).Copy
        Cells(2, 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    End If
    Cells(96, 76).Select
End Sub

Option Explicit
Public Function VertCerca(Nome As Variant, Ditta As Range, Col_Des As Variant) As Variant
Application.Volatile
Dim Ditt_a As Variant
Dim Nriga As Long
For Each Ditt_a In Ditta
 If Ditt_a = Nome Then
   Nriga = Ditt_a.Row
   Exit For
 End If
Next
If Nriga > 0 Then
  VertCerca = Cells(Nriga, Col_Des)
Else
  VertCerca = "Valore non Trovato -> " & Nome
End If
End Function

'---------------------------------------------------------------------------------------
' Procedure : CercaVert
' Author    : Scossa
' Date      : 25/03/2015
' Purpose   : Ricerca sWath nel range Rng e restituisce il
'             valore della cella spostata lCol rispetto alla
'             cella dove il valore è stato trovato.
'---------------------------------------------------------------------------------------
'

Public Function CercaVert( _
  ByVal vWath As Variant, _
  ByRef rng As Range, _
  ByVal nCol As Long, _
  Optional ByVal bPart As Boolean = False) As Variant
    
  Application.Volatile
  Dim rFound As Range
  Dim vToken As Variant
  
  
  vToken = Application.VLookup(vWath, rng, 1, --bPart)
  If Not IsError(vToken) Then
    Set rFound = rng.Find(vToken, After:=rng.Cells(rng.Rows.Count), _
        LookAt:=IIf(bPart, xlPart, xlWhole), _
        SearchDirection:=xlNext)
        CercaVert = rFound.Offset(, nCol).Value
  Else
    CercaVert = CVErr(Excel.xlErrNA)
  End If
End Function

'---------------------------------------------------------------------------------------
' Procedure : CercaVert
' Author    : Scossa
' Date      : 25/03/2015
' Purpose   : Ricerca sWath nel range Rng e restituisce il
'             valore della cella spostata lCol rispetto alla
'             cella dove il valore è stato trovato.
'---------------------------------------------------------------------------------------
'

Public Function CercaVert( _
  ByVal vWath As Variant, _
  ByRef rng As Range, _
  ByVal nCol As Long, _
  Optional ByVal bPart As Boolean = True) As Variant
    
  Application.Volatile
  Dim rFound As Range
  Dim vToken As Variant
  
  
  vToken = Application.VLookup(vWath, rng, 1, --bPart)
  If Not IsError(vToken) Then
    Set rFound = rng.Find(vToken, After:=rng.Cells(rng.Rows.Count), _
        LookAt:=xlWhole, _
        SearchDirection:=xlNext)
        CercaVert = rFound.Offset(, nCol).Value
  Else
    CercaVert = CVErr(Excel.xlErrNA)
  End If
End Function

'In un modulo.
'utilizzo: v_lookup(range("F1:F6"), "topolino").offset(,-2)
Option Explicit

Function v_lookup(r As Range, value As Variant, Optional interval As Boolean = True) As Variant
Dim cell As Range, i As Integer, s As String
'interval:
'Valore logico che specifica se si desidera trovare una corrispondenza esatta o approssimativa mediante la funzione CERCA.VERT:

    'se interval è True o omesso,
    If interval = True Then
        'viene prima cercata una corrispondenza esatta
        Set cell = r.Find(value, LookAt:=xlWhole)
        If cell Is Nothing Then
            'e se non viene trovata viene cercata una corrispondenza parziale
            Set cell = r.Find(value, LookAt:=xlPart)
            If cell Is Nothing Then
                'se non viene trovata viene restituita una corrispondenza approssimativa (il successivo valore più grande, inferiore a valore)
                'per fare questo scorre la stringa di ricerca cercando nel range il più grande valore possibile che coincida con la ricerca parziale
                i = Len(value) - 1
                Do
                    s = Left(value, i)
                    Set cell = r.Find(s, LookAt:=xlPart)
                    i = i - 1
                Loop Until Not (cell Is Nothing) Or i < 0
                If cell Is Nothing Then
                    'se non è trovata ancora alcuna corrispondenza, restituisce il valore della prima cella del range
                    Set v_lookup = r.Cells(1)
                Else
                    'trovata una corrispondenza parziale, restituisce il valore della cella trovata
                    Set v_lookup = cell
                End If
            Else
                Set v_lookup = cell
            End If
        Else
            Set v_lookup = cell
        End If
    Else
        'se interval è False viene cercata una corrispondenza esatta
        Set cell = r.Find(value, LookAt:=xlWhole)
        If cell Is Nothing Then
            'e se non viene trovata restituisce l'errore #N/D
            v_lookup = "#N/D"
        Else
            Set v_lookup = cell
        End If
    End If

End Function

'---------------------------------------------------------------------------------------
' Procedure : CercaVert
' Author    : Scossa
' Date      : 25/03/2015
' Purpose   : Ricerca sWath nel range Rng e restituisce il
'             valore della cella spostata lCol rispetto alla
'             cella dove il valore è stato trovato.
'---------------------------------------------------------------------------------------
'

Public Function CercaVert( _
  ByVal vWath As Variant, _
  ByRef rng As Range, _
  ByVal nCol As Long, _
  Optional ByVal bPart As Boolean = True) As Variant
    
  Application.Volatile
  Dim rFound As Range
  Dim vToken As Variant
  
  
  vToken = Application.VLookup(vWath, rng, 1, --bPart)
  If Not IsError(vToken) Then
    Set rFound = rng.Find(vToken, After:=rng.Cells(rng.Rows.Count), _
        LookAt:=xlWhole, _
        SearchDirection:=xlNext)
        CercaVert = rFound.Offset(, nCol).value
  Else
    CercaVert = CVErr(Excel.xlErrNA)
  End If
End Function

'---------------------------------------------------------------------------------------
' Procedure : CercaVert2
' Author    : Scossa
' Date      : 25/03/2015
' Purpose   : Ricerca sWath nella colonna nWhere del range Rng e restituisce il
'             valore della cella spostata lCol rispetto alla
'             cella dove il valore è stato trovato.
' N.B.      : rng deve essere un range che comprenda sia la colonna di ricerca
'             che quella di restituzione, come in CERCA.VERT()
'---------------------------------------------------------------------------------------
'
Public Function CercaVert2( _
  ByVal vWath As Variant, _
  ByRef rng As Range, _
  ByVal nWhere As Long, _
  ByVal nCol As Long, _
  Optional ByVal bPart As Boolean = True) As Variant
    
  
  Dim rFound As Range
  Dim vToken As Variant
  
  Set rng = Intersect(rng, rng.Columns(nWhere))
  vToken = Application.VLookup(vWath, rng, 1, --bPart)
  If Not IsError(vToken) Then
    Set rFound = rng.Find(vToken, After:=rng.Cells(rng.Rows.Count), _
        LookAt:=xlWhole, _
        SearchDirection:=xlNext)
        CercaVert2 = rFound.Offset(, nCol).Value
  Else
    CercaVert2 = CVErr(Excel.xlErrNA)
  End If
End Function