De Martin.PAOLO
00giovedì 17 agosto 2023 12:02
Salve a tutti, chiedo il vostro aiuto
Questa macro mi cerca i numeri in un determinato range e lo evidenzia in giallo.
Avrei bisogno che oltre ai numeri mi cercasse anche testo.
Grazie
Sub Macro1()
' Scelta rapida da tastiera: CTRL+q
Dim plage As Range, valeur, x, t
t = 0
Set plage = Range("A1:w50")
valeur = InputBox("Valore da trovare:")
If valeur = "" Then Exit Sub
If InStr(1, valeur, _
Application.International(xlDateSeparator)) > 0 Then valeur = CDate(valeur) Else valeur = Val(valeur)
For Each x In plage
If x = valeur Then
Cells(x.Row, x.Column).Select: t = 1
End If
Next x
If t = 0 Then MsgBox ("Valore non trovato")
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End Sub
by sal
00venerdì 18 agosto 2023 06:56
Ciao Meglio se inserisci un file con acuni dati ed il risultato voluto, si ragiona meglio.
Ciao By Sal (8-D
Marius44
00venerdì 18 agosto 2023 07:49
Ciao
Se ho capito bene pur in assenza di un tuo esempio prova a correggere la macro così
Sub Macro1()
' Scelta rapida da tastiera: CTRL+q
Dim plage As Range, valeur, x, t
t = 0
Set plage = Range("A1:w50")
plage.Interior.Pattern = xlNone 'elimina colori precedenti
valeur = InputBox("Valore da trovare:")
If valeur = "" Then Exit Sub
'If InStr(1, valeur, _
'Application.International(xlDateSeparator)) > 0 Then valeur = CDate(valeur) Else valeur = Val(valeur)
For Each x In plage
If x = valeur Then
Cells(x.Row, x.Column).Select: t = 1
End If
Next x
'da sdoppiare altrimenti colora la cella W50
If t = 0 Then
MsgBox ("Valore non trovato")
Else
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End If
End Sub
Fai sapere. Ciao,
Mario
De Martin.PAOLO
00venerdì 18 agosto 2023 09:58
Ciao Mario, la tua istruzione mi trova solo il testo e non i numeri. Vorrei che me li trovasse entrambe se è possibile
tanimon
00venerdì 18 agosto 2023 11:20
Re:
De Martin.PAOLO, 18/08/2023 09:58:
Ciao Mario, la tua istruzione mi trova solo il testo e non i numeri. Vorrei che me li trovasse entrambe se è possibile
e secondo te,
Mario o chi per lui,
dovrebbe crearsi da capo un file che tu hai già, che interessa solo a te e non vuoi allegare.....
credi che Mario abbia il cappello a punta come Merlino?
nella Sua foto non l'ho mai visto 😀
Prova a metterti nei panni di Mario che già ha fatto tanto a risponderti,
poi....
mi dici se tu avresti fatto o faresti altrettanto....
De Martin.PAOLO
00venerdì 18 agosto 2023 12:00
Si scusate, ecco il file
tanimon
00venerdì 18 agosto 2023 12:03
per me è tardi
PASSO E CHIUDO
Marius44
00venerdì 18 agosto 2023 15:38
Ciao
Visto il codice già presente, modifica la macro così
Sub Macro1()
' Scelta rapida da tastiera: CTRL+q
Dim plage As Range, valeur, x, t
t = 0
Set plage = Range("A1:w50")
plage.Interior.Pattern = xlNone 'elimina colori precedenti
valeur = InputBox("Valore da trovare:")
If valeur = "" Then Exit Sub
For Each x In plage
If IsNumeric(valeur) Then
If x = Val(valeur) Then Cells(x.Row, x.Column).Select: t = 1
ElseIf Not IsNumeric(valeur) Then
If x = valeur Then Cells(x.Row, x.Column).Select: t = 1
End If
If t = 1 Then Exit For
Next x
End Sub
Fai sapere. Ciao,
Mario
L2018
00venerdì 18 agosto 2023 16:03
ciao Mario, perdonerai se ho tentato di rimettere il colore
VB
Sub Marius()
' Scelta rapida da tastiera: CTRL+q
Dim plage As Range, valeur, x, t
Application.ScreenUpdating = False
t = 0
Set plage = Range("A1:W50")
plage.Interior.Pattern = xlNone 'elimina colori precedenti
valeur = InputBox("Valore da trovare:")
If valeur = "" Then Exit Sub
For Each x In plage
If IsNumeric(valeur) Then
If x = Val(valeur) Then Cells(x.Row, x.Column).Select: t = 1
ElseIf Not IsNumeric(valeur) Then
If x = valeur Then Cells(x.Row, x.Column).Select: t = 1
End If
If t = 1 Then Exit For
Next x
If t = 0 Then MsgBox ("Valore non trovato")
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Application.ScreenUpdating = True
End Sub
MA........
dopo sistemato il colore vedo pubblicato il vero file, ed allora non si puo' NON dare ragione anche a Tanimon per la sua obiezione.
mi chiedo per quale motivo gli utenti non pensino di postare subito il file di esempio o di riferimento, tanto più se non ingombrante.
E' una questione di delicatezza verso i possibili aiutanti
penso che ora tocchi all' OP sistemare uno dei suggerimenti nel suo file
Leo
Marius44
00venerdì 18 agosto 2023 17:48
Buon pomeriggio
in effetti siamo carenti della presenza dell'OP che sembra "spaventato" dal mio codice; aspettiamo sue nuove.
@L2018
Come ho detto al post precedente, vista la presenza del codice che inserisce e/o elimina il colore, nel mio suggerimento l'avevo tolto.
Certo che ha ragione @tanimon (ciao Frank) ma oggi mi sento "buono" 😁
Ciao,
Mario
federico460
00venerdì 18 agosto 2023 18:18
ciao
per pura curiosità ho fatto
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = xlNone
ActiveCell.Interior.ColorIndex = 6
End Sub
Sub Cerca_numeri()
Dim Lista As Range
On Error GoTo xxx
valeur = InputBox("Valore da trovare:")
If valeur = "" Then Exit Sub
Set Lista = Range("A1:W50")
For Each cl In Lista
If cl = valeur * 1 Then
cl.Interior.ColorIndex = 6
End If
Next
xxx:
For Each cl In Lista
If cl = valeur Then
cl.Interior.ColorIndex = 6
End If
Next
End Sub
gentilmente me lo verificate
a me sembra funzioni
anche se al click io aggiungerei l'azzeramento del colore
L2018
00venerdì 18 agosto 2023 18:57
Ciao Federico,
il tuo codice funziona e ha il vantaggio che se in archivio ci sono diversi valori uguali li colora tutti,e io concordo
ma ha un difetto
la colorazione precedente non viene eliminata
Leo
ah, scusa, citavi l'azzeramento del colore, be', direi che è opportuno azzerarlo, ad ogni ricerca
federico460
00venerdì 18 agosto 2023 19:04
ciao
infatti l'ho scritto
anche se al click io aggiungerei l'azzeramento del colore
basta aggiungere
Range("A1:W50").Interior.ColorIndex = xlNone
Sub Cerca_numeri()
Dim Lista As Range
Range("A1:W50").Interior.ColorIndex = xlNone
On Error GoTo xxx
valeur = InputBox("Valore da trovare:")
ecc..................
ma lui lo fa cambiando la selezione
perciò non so se debbano rimanere colorate tutte le ricerche
L2018
00venerdì 18 agosto 2023 19:09
direi che funziona
magari aggiungerei un bordo moderato alle celle colorate, che poi anche lui deve sparire
Leo
by sal
00sabato 19 agosto 2023 08:13
Ciao Buongiorno a tutti, invece del pulsante che apre un inputbox, ho inserito direttamente un Textbox in cui inserire la ricerca e sotto un pulsantino per la cancellazione del colore.
questo tutto il codice usato
Sub TrovaT(k) 'cerca il dato
Dim r, c, x, rng
Set rng = Range("Selez")
rng.Interior.Color = xlNone
For Each x In rng
If k = x Then Cells(x.Row, x.Column).Interior.ColorIndex = 6
Next x
TextBox1 = ""
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 'Textbox invio
Dim d
If KeyCode = 13 Then
d = TextBox1
If IsNumeric(d) Then d = Val(d) Else d = UCase(d)
Call TrovaT(d)
Cells(1, 1).Select
End If
End Sub
Sub DClr() 'cancella colore
Set rng = Range("Selez")
rng.Interior.Color = xlNone
End Sub attenzione che per il Range di ricerca ho usato una definizione Nomi "Selez" per cercare solamente nelle celle di ricerca, nel caso su un altro file trasferire il Nome
ho pensato che era inutile avere un pulsante per aprire la Txt di ricerca "InputBox" meglio averla sempre disponibile, se mi serve scrivo il nome e via, vede anche il testo e doppioni se ci saranno
si poteva anche fare la ricerca direttamente nel codice della TextBox, ma ho preferito separarla.
allego anche il file, il resto non ho toccato niente
Ciao By Sal (8-D
L2018
00sabato 19 agosto 2023 08:33
ciao Sal
anche la tua è ottima alternativa, grazie
Leo
De Martin.PAOLO
00sabato 19 agosto 2023 12:00
Grazie ragazzi per le risposte.
Per ora ho provato la soluzione di Marius44 e funziona benissimo. Poi provo le altre
Ciao
Paolo
De Martin.PAOLO
00sabato 19 agosto 2023 14:44
Re:
Marius44, 18/08/2023 15:38:
Ciao
Visto il codice già presente, modifica la macro così
Sub Macro1()
' Scelta rapida da tastiera: CTRL+q
Dim plage As Range, valeur, x, t
t = 0
Set plage = Range("A1:w50")
plage.Interior.Pattern = xlNone 'elimina colori precedenti
valeur = InputBox("Valore da trovare:")
If valeur = "" Then Exit Sub
For Each x In plage
If IsNumeric(valeur) Then
If x = Val(valeur) Then Cells(x.Row, x.Column).Select: t = 1
ElseIf Not IsNumeric(valeur) Then
If x = valeur Then Cells(x.Row, x.Column).Select: t = 1
End If
If t = 1 Then Exit For
Next x
End Sub
Fai sapere. Ciao,
Mario
Marius, questo codice funziona bene, ma se cerco una lettera maiuscola e sul box la scrivo minuscola non la trova
federico460
00sabato 19 agosto 2023 15:09
ciao
aggiungi sopra alla macro
Option Compare Text
by sal
00sabato 19 agosto 2023 15:14
Ciao Visto che le tue lettere sono tutte in maiuscolo, ho fatto la trasformazione in maiscolo nel caso inserisci la lettera in minuscolo, quindi vede solo le maiuscole,
Però visto che il codice di Mario che saluto, funziona, puoi fare un questo modo, senza toccare niente, ad inizio del modulo la prima riga in alto scrivi solo
in questo modo non ha importanza se il dato viene inserito in maiuscolo o minuscolo viene letto lo stesso.
Ciao By Sal (8-D
De Martin.PAOLO
00sabato 19 agosto 2023 15:15
Re:
federico460, 19/08/2023 15:09:
ciao
aggiungi sopra alla macro
Option Compare Text
OK, perfetto grazie
Ciao