' Il nome del corrente modulo VBA (Visual Basic for Application) ' deve iniziare con i caratteri "Modulo" ed avere estensione ".bas". ' Per importarlo dentro un Excel 2007 ".xlsm" (con macro attivate), esegui ' Sviluppo, Visual Basic, File, Importa file... ' e, infine, scegli il file corrente dalla finestra di importazione. ' Attribute VB_Name = "Modulo_XLOOKUP" Function XLOOKUP(Valore As Variant, _ Matrice As Range, _ Riga As Boolean _ ) As Variant ' Definisce la funzione XLOOKUP. ' Riceve. ' 1) Valore Campo numerico o indirizzo di cella. ' 2) Matrice Area rettangolare definita ' dalla cella dell'angolo superiore sinistro ' e da quella opposta dell'angolo inferiore destro. ' 3) Riga Switch binario. ' Vero =1 =Restituisce numero relativo di riga. ' Falso =0 =Restituisce numero relativo di colonna. ' Restituisce. ' 1) XLOOKUP Numero relativo di riga o di colonna (vedi parametro Riga). ' Valore viene cercato in Matrice per riga/colonna, ' prima le celle della prima riga da sinistra a destra, ' poi, ordinatamente dall'alto in basso le celle delle altre righe. ' Se la ricerca ha buon esito, restituisce riga o colonna ' della prima cella soddisfacente. ' Se la ricerca fallisce, restituisce zero. '---------- ' Se il parametro Valore è un campo numerico. If (VarType(Valore) = 5) Then ' Assume il valore come parola di ricerca. Word = Valore ' Se il parametro Valore è il riferimento ad una cella. Else ' Assume il valore della cella come parola di ricerca. Word = Valore.Value ' Se il parametro... End If ' Cerca e annota il primo indirizzo trovato. ' Per ogni cella nella matrice. For Each Cella In Matrice ' Se il contenuto della cella è uguale alla parola cercata. If (Cella.Value = Word) Then ' Se è richiesta la riga. If Riga = True Then ' Restituisce il numero relativo della riga. XLOOKUP = Cella.Row - Matrice.Row + 1 ' Se è richiesta la colonna. Else ' Restituisce il numero relativo della colonna. XLOOKUP = Cella.Column - Matrice.Column + 1 ' Se è richiesta... End If ' Abbandona. Exit For ' Se il contenuto della cella è uguale alla parola cercata. End If ' Per ogni cella nella matrice. Next End Function Function XLOOKUP2(Valore As Variant, _ Matrice As Range, _ Riga As Boolean _ ) As Variant ' Versione più lenta di XLOOKUP. If (VarType(Valore) = 5) Then Word = Valore Else Word = Valore.Value End If RowBeg = Matrice.Row ColBeg = Matrice.Column RowEnd = RowBeg + Matrice.Rows.Count - 1 ColEnd = ColBeg + Matrice.Columns.Count - 1 For Row = RowBeg To RowEnd For Col = ColBeg To ColEnd Valo = Cells(Row, Col).Value If (Valo = Word) Then Fuori = 1 If Riga = True Then XLOOKUP2 = Row - RowBeg + 1 Else XLOOKUP2 = Col - ColBeg + 1 End If GoTo Fine End If Next Next Fine: End Function