Ricerca lista di parole in una matrice Excel di x righe e y colonne

Question

Buonasera, dovrei cercare una lista di parole (circa 400) in una matrice Excel (circa 3000 righe per 8 colonne), nella quale ogni cella contiene un testo composto da varie parole. Una volta individuate queste parole devono essere evidenziate. 

A titolo di esempio:

vettore con le parole da cercare: pippo, pluto, topolino

matrice Excel:

A1 = La storia in cui pippo compare come amico di pluto... --> le parole pippo e pluto devono essere evidenziate

B1 = Forse solo topolino è il personaggio... --> evidenziare topolino

C1 = Chissà se riusciremo a risolvere questo problema --> non trovata alcuna corrispondenza (il contenuto della cella resta invariato)

Nella ricerca non si devo tenere conto della punteggiatura; vale a dire che se una cella contiene ad esempio (Non si deve dimenticare che pippo, amico di topolino, è un vero...) --> la ricerca deve evidenziare pippo e topolino anche se sono accompagnati da una virgola.

Grazie per il supporto

Answer 1

Ciao Luca,

se pensi che la soluzione proposta abbai risolto la tua questione ti chiedere di indicare che si tratta di una "Risposta".

In tal modo se qualche altro utente ricercasse una soluzione simile potrebbe più facilmente individuarla.

Grazie per il riscontro :)

Answer 2

Grazie mille, gentilissimo.

E' stato utilissimo.

Buona serata

Luca

Answer 3

Ciao, non specifichi da dove prelevare l'elenco delle parole da ricercare nelle frasi e se l'intervallo dove sono presenti nelle frasi sia identificabile in "automatico".

Comunque ti propongo questo file di esempio: File esempio

In un primo foglio nominato Lista Parole ho inserito una lista (ListObject in vba) dove ho inserito le parole da ricercare. In questo modo ho un riferimento "stabile" alla matrice di parole da ricercare nelle frasi.

In un secondo foglio nomiato Foglio Frasi ho inserito delle frasi come da tuo esempio (ripetute per mia comodità).

Nel modulo1 del progetto VBA della cartella di lavoro ho inserito il seguente codice VBA:

'---

Option Explicit

Sub EvidenziaListaParole()

   Const sFoglioListaParole As String = "Lista Parole"

   Const sListaParole As String = "ListaParole"

   Const sFoglioFrasi As String = "Foglio Frasi"

   Const sIntervalloFrasi As String = "A1:H4000" '<--- da personalizzare in base all'intervallo

   Dim bElaboraParole As Boolean

   Dim arrListaParole As Variant

   Dim v As Variant

   Dim rngFrasi As Range

   Dim c As Range

   Dim iPos As Long

   With Application

      .Calculation = xlCalculationManual

      .EnableEvents = False

      .ScreenUpdating = False

   End With

   On Error GoTo Errore

   With ThisWorkbook

      With .Worksheets(sFoglioListaParole)

         With .ListObjects(sListaParole)

            If Not .DataBodyRange Is Nothing Then

               arrListaParole = .DataBodyRange.Value

               bElaboraParole = True

            End If

         End With

      End With

      If bElaboraParole Then

         Set rngFrasi = .Worksheets(sFoglioFrasi).Range(sIntervalloFrasi)

         For Each c In rngFrasi

            If c.Value <> vbNullString Then

               For Each v In arrListaParole

                  If v <> vbNullString Then

                     iPos = 0

                     Do

                        iPos = InStr(iPos + 1, c.Value, v, vbTextCompare)

                        If iPos > 0 Then

                           With c.Characters(iPos, Len(v)).Font

                              .Bold = True   'grassetto

                              .Italic = True 'corsivo

                              .Color = vbRed 'rosso

                           End With

                        End If

                     Loop Until iPos = 0

                  End If

               Next v

            End If

         Next c

      End If

   End With

RiprendiErrore:

   With Application

      .Calculation = xlCalculationAutomatic

      .EnableEvents = True

      .ScreenUpdating = True

   End With

   Exit Sub

Errore:

   MsgBox "Si è verificato un errore!" & vbNewLine & _

          "Errore n. " & Err.Number & vbNewLine & _

          Err.Description, vbCritical, "Errore VBA"

   Resume RiprendiErrore

End Sub

'---

La procedura ricerca nel foglio "Foglio Frasi" in ciascuna cella dell'intervallo indicato nella constante sIntervalloFrasi(in esempio A1:H4000) le parole presenti nella lista nel foglio "Lista Parole".

Se trova la parola (la ricerca in esempio non tiene conto di maiuscole/minuscole) applica alla parola il grassetto, il corsivo e il colore rosso (ovviamente è possibile "disabilitare" ciò che non interessa tramite un apice ' posto davanti alla riga di istruzione.

Se una parola è contenuta più volte nella stessa frase quella parola verrà "formatta" per tutte le occorrenze.

Quello che ottengo è qualcosa del genere:

Prova a vedere se è quello che chiedi.

Tieni presente che per 400 parole e un intervallo di 4.000 righe e 8 colonne sul mio pc ci ha impiegato circa 8'.

ciao