Prosegui ricerca

Hai un problema con Excel?

Nuova discussione

Prosegui ricerca
di Perry data: 12/04/2014 16:51:41
In una tabella eseguo la ricerca di un testo ( colonna B) che funziona e si posiziona nella cella dove ha trovato la corrispondenza.
Vorrei che, su richiesta, la ricerca proseguisse eventuali n-volte trovandomi altre corrispondenze oppure "testo non trovato"
La prosecuzione della ricerca deve essere pilotata con "proseguo si/no"
Grazie

Allego il codice abbinato al Bottone "Cerca Testo" .:

Sub E_Cerca_Testo()
Dim Testo, E_oTbl As ListObject, Lr As Long
Set E_oTbl = ActiveSheet.ListObjects("Excel_Tab")
Testo = Range("Excel_Testo")

With E_oTbl
Lr = .ListRows.Count
Range("B1:B" & Lr).Find(Testo, after:=Range("B1")).Select
End With

Range("Excel_Testo") = "Inserisci qui il Testo"
Set E_oTbl = Nothing

di gaetanopr data: 12/04/2014 18:03:59
Ciao, dovresti usa in FindNext
Prova in questo modo io non l'ho testato

Set Rng = Range("B1:B" & Lr).Find(Testo, after:=Range("B1"))
If Not Rng Is Nothing Then
    firstAddress = Rng.Address
    Do
    Rng.Select
    If MsgBox("proseguo si/no", vbYesNo, "Ricerca") = vbNo Then Exit Sub
    Set Rng = Range("B1:B" & Lr).FindNext(Rng)
    Loop While Not Rng Is Nothing And Rng.Address <> firstAddress
End If

di gaetanopr data: 12/04/2014 18:07:06
Cambia Exit Sub con Exit Do altrimenti non prosegue con le altre istruzioni
If MsgBox("proseguo si/no", vbYesNo, "Ricerca") = vbNo Then Exit Do
di Perry (utente non iscritto) data: 12/04/2014 19:42:55
Grazie del tuo intervento.
Ho provato ad inserire il tuo codice nel mio ma mi da errore. Ecco il codice.:

Sub E_Cerca_Testo()
Dim Testo, E_oTbl As ListObject, Lr As Long

Dim Rng As Range, firstaddress As Long <-- dichiarazione tue variabili

Set E_oTbl = ActiveSheet.ListObjects("Excel_Tab")
Testo = Range("Excel_Testo")

<--- inizio tuo codice --------------------------------------------------------
Set Rng = Range("B1:B" & Lr).Find(Testo, after:=Range("B1"))
If Not Rng Is Nothing Then
firstaddress = Rng.Address
Do
Rng.Select
If MsgBox("proseguo si/no", vbYesNo, "Ricerca") = vbNo Then Exit Do
Set Rng = Range("B1:B" & Lr).FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> firstaddress
End If
<--- fine tuo codice --------------------------------------------------------------

Range("Excel_Testo") = "Inserisci qui il Testo"
Set E_oTbl = Nothing
End Sub

Perry
di gaetanopr data: 12/04/2014 19:54:17
Ciao, ti sei dimenticato della variabile Lr
Lr = .ListRows.Count
di gaetanopr data: 12/04/2014 19:58:37
naturalmente se non usi With diventa E_oTbl.ListRows.Count
di Perry (utente non iscritto) data: 12/04/2014 20:14:40
Ancora Grazie
ho corretto il codice (Lr) ma continua darmi errore, come devo impostare RNG ?.:

Sub E_Cerca_Testo()
Dim Testo, E_oTbl As ListObject, Lr As Long

Dim Rng As Range, firstaddress As Long

Set E_oTbl = ActiveSheet.ListObjects("Excel_Tab")
Testo = Range("Excel_Testo")
Lr = E_oTbl.ListRows.Count <-- correzione

Set Rng = Range("B1:B" & Lr).Find(Testo, after:=Range("B1"))
If Not Rng Is Nothing Then
firstaddress = Rng.Address <---- errore 13 tipo non corrispondente
Do
Rng.Select
If MsgBox("proseguo si/no", vbYesNo, "Ricerca") = vbNo Then Exit Do
Set Rng = Range("B1:B" & Lr).FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> firstaddress
End If

Range("Excel_Testo") = "Inserisci qui il Testo"
Set E_oTbl = Nothing
End Sub
di gaetanopr data: 12/04/2014 20:17:23
firstaddress As String e non Long
Che tipo di errore restituisce? se puoi e continua a dare errore allega un esempio
di Perry (utente non iscritto) data: 12/04/2014 20:22:53
Perfetto, funziona tutto, grazie 1k
Un saluto a tutti
Perry

Vuoi Approfondire?