[Excel 2003] Ricerca valori corrispondenti

[enrico43]

Buongiorno, la sottostante macro per cercare la corrispondenza dei moltissimi valori (euri) contenuti nella colonna G con valori presi da foglio cartaceo.
Dovrei risolvere 2 problemi, prevedere una tolleranza (cioè ci possono essere differenze di pochi euro tra il numero della colonna G e quello del foglio di carta di max 10 euro che credevo di risolvere con gli asterischi) ed i numeri “somiglianti”, cioè che contengono (nella colonna G) le cifre digitate.
http://www.filedropper.com/riepilogoneincorso
Molto depurato.
La macro è

Codice: Seleziona tutto

Option Compare Text
Sub CercaValore()
Dim CL As Object
Set Zona = ActiveSheet.Range("G:G")
Dimmi = InputBox("Scrivi il valore")
If Dimmi = "" Then Exit Sub
For Each CL In Zona
If CL.Value Like "*" & Dimmi & "*" Then
‘CL.Select
‘Dove = CL.Address(rowabsolute:=False, columnabsolute:=False)
CL.EntireRow.Select
Selection.Interior.ColorIndex = 6
End If
Next
10:
MsgBox "Ricerca Terminata"
End Sub

Ringrazio anticipatamente per l’attenzione.
Cordiali saluti
Enrico

[Anthony47]

Non so se questa variante risponde al tuo obiettivo:

Codice: Seleziona tutto

Sub cerca2()
Dim CL As Range, TollPc As Single, TollVal As Long, myRan As String, I As Long
Dim ApproxL As Single, ApproxU As Single, LastG As Long, Dimmi As String
'
TollPc = 0.5        '<< esempio per 0,5 % di tolleranza
'TollVal = 10
ApproxL = (100 - TollPc) / 100
ApproxU = (100 + TollPc) / 100
LastG = Cells(Rows.Count, "G").End(xlUp).Row
Dimmi = InputBox("Scrivi il valore")
If Dimmi = "" Then Exit Sub
For I = 1 To LastG
    If IsNumeric(Cells(I, "G")) Then
        If Cells(I, "G").Value * ApproxL <= CLng(Dimmi) And Cells(I, "G").Value * ApproxU >= CLng(Dimmi) Then
            myRan = myRan & Cells(I, "G").Address & ", "
        End If
    End If
Next I
If myRan <> "" Then
    myRan = Left(myRan, Len(myRan) - 2)
    Range(myRan).Select
    Selection.Interior.ColorIndex = 4
End If
End Sub


Essa imposta una tolleranza percentuale sul valore da cercare (vedi riga marcata <<) ; in alternativa puoi inserire la tolleranza in una cella del tuo foglio di lavoro (come valore "intero", cioe' scrivendo 0,5 per indicare 0,5%), e poi invece di TollPc = 0.5 scrivi TollPc = Range("LaMiaCella").value
Con lo stesso approccio, invece di una tolleranza percentuale potresti utilizzare una tolleranza di valore; in questo caso modificherai la "If" centrale in

Codice: Seleziona tutto

        If Cells(I, "G").Value - TollVal <= CLng(Dimmi) And Cells(I, "G").Value + TollVal >= CLng(Dimmi) Then

Ciao

[enrico43]

Stasera la provo (non sei solo tu a fare gli straordinari, gratuiti, in favore di noi VBnauti) e poi ti aggiorno.
Insieme ad un grosso Grazie, ti saluto
Enrico