Aiuto per registro scolastico

Public Function CercaMVert( _
    ByVal sWhat As String, _
    ByVal rng As Range, _
    ByVal lCol As Long, _
    Optional ByVal sSep As String = " ", _
    Optional ByVal bNum As Boolean = False) As Variant
'
'----------------------------------------------------
' di Scossa
' Ricerca *sWhat* nel range *Rng* (di 1 sola colonna)
' e restituisce *concatenandoli* i valori delle celle
' spostate *lRow* rispetto alla cella dove il valore
' è stato trovato.
' se bNum = 1 e sSep è "+" o "-" o  "*" o "/"
' ed i valori sono numerici verrà restituito
' il risultato dell'operazione
'----------------------------------------------------

Dim rFound As Range
Application.Volatile
Dim nRow As Long
Application.Volatile
Dim nLastRow As Long
Application.Volatile
Dim rLastCell As Range
Application.Volatile
Dim shFrom As Worksheet
Application.Volatile
Dim cAddress As String
Application.Volatile
Dim nLen As Long
Application.Volatile
Dim nAt As Long
Application.Volatile

  Set shFrom = rng.Parent
  nRow = Application.WorksheetFunction.Max(rng.Row - 1, 1)
  cAddress = rng.Address
  nLen = Len(cAddress)
  nAt = InStrRev(cAddress, "$", InStrRev(cAddress, "$", nLen) - 1)
  cAddress = Mid(cAddress, nAt)
  Set rLastCell = rng.Parent.Range(cAddress)
  nLastRow = rLastCell.Row

  Set rFound = rng.Find(sWhat, searchorder:=xlByColumns, after:=rLastCell, LookIn:=xlValues)
  
  If Not rFound Is Nothing Then
      cAddress = rFound.Address
      If InStr("+-*/", sSep) > 0 And bNum Then
        Do
          CercaMVert = CercaMVert & sSep & IIf(IsNumeric(rFound.Offset(0, lCol).Value), rFound.Offset(0, lCol).Value, 0)
          Set rng = Intersect(rng, rFound.Resize(Cells.Rows.Count - rFound.Row, 1))
          nRow = rng.Row
          cAddress = rFound.Address
          Set rFound = rng.Find(sWhat, LookIn:=xlValues)
        Loop While Not rFound Is Nothing And nRow < nLastRow And rFound.Address <> cAddress
        CercaMVert = Evaluate(Mid(CercaMVert, 2))
      Else
        Do
          CercaMVert = CercaMVert & _
              rFound.Offset(0, lCol).Value & sSep '";"
          Set rng = Intersect(rng, rFound.Resize(Cells.Rows.Count - rFound.Row, 1))
          nRow = rng.Row
          cAddress = rFound.Address
          Set rFound = rng.Find(sWhat, LookIn:=xlValues)
        Loop While Not rFound Is Nothing And nRow < nLastRow And rFound.Address <> cAddress
        CercaMVert = Left(CercaMVert, Len(CercaMVert) - Len(sSep))
      End If
  Else
      CercaMVert = "?" 'CVErr(Excel.xlErrNA)
  End If
  
  Set shFrom = Nothing
  Set rLastCell = Nothing
  Set rng = Nothing

End Function