problemi con la visualizzazione di una ricerca.

[mflautoPartecipante mflauto Karma: 1 pt]

Buongiorno a tutti, ho creato una piccola istruzione per la ricerca di una targa in un DB (vedi file allegato), l'unico problema

è che se la targa si trova nella porzione di schermo la visualizzo; ma se si trova in un altro punto della tabella devo scorrere con il mouse tutta la tabella per cercarla.

Sub Cerca_Tg()

Application.ScreenUpdating = False
Dim Message, Title, MyValue

Sheets("DB").Activate ' attiva il foglio DB

Range("A2:A500").Interior.ColorIndex = xlNone 'cancella nell'intervallo di celle indicato (a2:a500) il colore di sfondo

With Worksheets(1).Range("A2:A500")

Message = "Inserisci la Targa da cercare :"
Title = "Ricerca Dati" ' apre una finestra per l'inserimento della targa da cercare

' Visualizza il messaggio, il titolo
MyValue = InputBox(Message, Title)

Dim X As String
X = MyValue  'viene assegnato alla X il contenuto della Inputbox
Set c = .Find(X, LookIn:=xlValues, LookAt:=xlWhole)


If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Cells.Select
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress

Else
MsgBox "Targa non Trovata" ' messaggio di targa non trovata
End If

End With

With Selection.Interior  'colora di arancione la cella trovata
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0

End With

Application.ScreenUpdating = True

End Sub

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Fai uno scroll sulla cella trovata. Dopo il Loop che individua la cella metti un Goto con il parametro scroll attivato:

Loop While Not c Is Nothing And c.Address <> firstAddress
Application.Goto c, True

[mflautoPartecipante mflauto Karma: 1 pt]

Graziee

[Autore]

Articoli