Ricerca con margine di tolleranza

Hai un problema con Excel?

Nuova discussione

Ricerca con margine di tolleranza
di DRINA (utente non iscritto) data: 03/04/2014 16:54:00
Ciao a tutti,
devo effettuare un cerca verticale fra importi, calcolando una tolleranza di +o-2.
Mi spiego meglio; in un foglio avrò 10.234,78 nell'altro 10.233,67.
Il cerca verticale dovrebbe trovarmi 10.233,67 perchè dentro la soglia del 2 di tolleranza.
Sono giorni che provo a creare una marco, ma inutilmente e non ho trovato nulla su questo argomento su Internet.
Mi potete aiutare?....grazie infinite...antonella
di Lucas87 data: 03/04/2014 16:59:03
Non credo che una formula basti.
Devi allegare un file per capire la struttura.
Se non ho capito male: dato un valore devi cercare il valore con una tolleranza +-2 in un altro foglio.
E se con quella tolleranza ci fossero più valori? Quale prendere?
di lepat (utente non iscritto) data: 03/04/2014 16:59:50
Hai letto le regole di utilizzo ? specialmente per quanto riguarda il TITOLO della discussione ?
Ricordatelo per la prossima volta.
Per quanto riguarda il tuo problema allega un file di esempio con dati, spiefazioni e risultato desiderato
di Vecchio Frac data: 03/04/2014 19:03:17
Ho modificato il titolo della discussione come da regolamento (era: "informazione").
Titoli troppo generici non sono adatti per eventuali ricerche future.
E comunque rischi di non suscitare l'interesse dei lettori :)
di dj2409200 data: 07/04/2014 17:29:11
Ciao a tutti,

mi scuso per la confusione!
Allego il file; per comodità ho inserito i dati in un'unica pagina (le colone Pe Q sarebbero in un altro file).

Il cerca verticale mi permette di controllare se gli importi della colonna H si trovano nella colonn ap (o nell'altro file) riportando poi nella colonna O il dato Q, qualora trovi l'importo.
Non riesco però a fare in modo, che qualora riscontri una tolleranza di tot (2 o 30 che siano, in più o in meno) mi attribuisca ugualmente il valore nella colonna O, invece dell #N/D.

vi ringrazio di cuore!!!!!
di totygno71 (utente non iscritto) data: 08/04/2014 11:03:22
Prova il file domandavba-toty

non mi piace molto come sistema ma se le righe non sono tantissime può essere funzionale.
Ciao Toty
di totygno71 (utente non iscritto) data: 08/04/2014 11:15:32
c'era un piccolo errore..
usa il file

domandaVBA-Toty1
di dj2409200 data: 08/04/2014 11:42:37
Ciao totygno71,

ti ringrazio molto.
Ho circa 2000 righe da testare; provo ad adattare il tutto sui due file che utilizzo e ti faccio sapere.

Grazie ancora....serena giornata...antonella

di scossa (utente non iscritto) data: 08/04/2014 14:41:07
Secondo me la "logica" è assolutamente improponibile: come fate, ad esempio, a stabilire che il 100.000 in H6 corrisponda al 100.000 in P4 anziché al 100.000 in P5?
Oppure: il 100.003 a quale dei due 100.000 dovrebbe corrispondere?

scossa's web site

Se tu hai una mela, ed io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno.
Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)

di dj2409200 data: 08/04/2014 15:17:46
Ciao Scossa,
in effetti hai ragione.
Noi però dobbiamo "spuntare" due file con provenienza diversa, controllando che il numero delle operazioni siano uguali e che i controvalori corrispondano (in realtà ci sono molte più colonne).
Non ci interessa tanto attribuire il corretto dato ai 100.000 giusti; utilizzando però il cerca verticale per il controllo dei controvalori (dato che DOBBIAMO verificare), rimangono #N/D quelle che hanno una piccola differenza che per noi non è significativa e quindi potremmo trattare come corretta.

Ti ringrazio per l'interessamento....buon tutto..antonella.

di scossa data: 08/04/2014 20:33:14
Allora, secondo me bisogna tenere conto dei valori via via incrociati, altrimenti si rischia di "spuntare" due importi uguali o simili in H con un unico valore in P.

Inserire in P1 il valore della tolleranza e poi lanciare la macro cliccando Check Cash.

Il codice mi sembra semplice, ma se servono chiarimenti .....

Allego il file DomandaVBA_scossa.xlsm

scossa's web site

'---------------------------------------------------------------------------------------
' Procedure : CheckCash
' Author    : scossa
' Date      : 08/04/2014
' Purpose   :
'---------------------------------------------------------------------------------------
'
Public Sub CheckCash()

  Dim wb As Workbook
  Dim ws As Worksheet
  Dim rng As Range
  Dim cella As Range
  Dim cPaym As Collection
  Dim vPaym As Variant
  Dim nMax As Currency
  Dim nMin As Currency
  Dim nToll As Currency
  Dim j As Long
  Dim bCalc As XlCalculation
  
  
  On Error GoTo CheckCash_Error
  
  Set wb = ThisWorkbook
  Set ws = wb.Worksheets("Foglio1")
  Set rng = ws.Range("H4:H" & ws.Cells(Rows.Count, 8).End(xlUp).Row)
  Set cPaym = New Collection

  nToll = ws.Range("P1").Value
  rng.Offset(, 7).ClearContents
  For Each cella In rng.Offset(, 8)
    With cella
      cPaym.Add Array(.Value, .Offset(0, 1).Value)
    End With
  Next cella

  For Each cella In rng
    With cella
      nMin = .Value - nToll
      nMax = .Value + nToll
      j = 0
      For Each vPaym In cPaym
        j = j + 1
        If (vPaym(0) = .Value) Or (vPaym(0) >= nMin And vPaym(0) <= nMax) Then
          cella.Offset(0, 7) = vPaym(1)
          cPaym.Remove j
          Exit For
        End If
      Next
    End With
  Next cella
  On Error GoTo 0
  'Exit Sub

CheckCash_Error:
  Set wb = Nothing
  Set ws = Nothing
  Set rng = Nothing
  Set cPaym = Nothing

  If Err.Number <> 0 Then
    MsgBox "Error: " & Err.Description, vbCritical, "ERRORE"
  End If
End Sub

di scossa data: 08/04/2014 22:17:10
Meglio fare due cicli separati: il primo per "spuntare" le corrispondenze esatte, il secondo per quelle "in tolleranza".

Allego il file domandaVBA2_scossa.xlsm

scossa's web site

'---------------------------------------------------------------------------------------
' Procedure : CheckCash
' Author    : scossa
' Date      : 08/04/2014
' Purpose   :
'---------------------------------------------------------------------------------------
'
Public Sub CheckCash()

  Dim wb As Workbook
  Dim ws As Worksheet
  Dim rng As Range
  Dim cella As Range
  Dim cPaym As Collection
  Dim vPaym As Variant
  Dim cCash As Collection
  Dim nMax As Currency
  Dim nMin As Currency
  Dim nToll As Currency
  Dim j As Long
  Dim k As Long
  Dim bCalc As XlCalculation
  
  
  On Error GoTo CheckCash_Error
  With Application
    bCalc = .Calculation
    .Calculation = xlCalculationManual
  End With
  Set wb = ThisWorkbook
  Set ws = wb.Worksheets("Foglio1")
  Set rng = ws.Range("H4:H" & ws.Cells(Rows.Count, 8).End(xlUp).Row)
  Set cCash = New Collection
  Set cPaym = New Collection

  nToll = ws.Range("P1").Value
  rng.Offset(, 7).ClearContents
  
  For Each cella In rng
    With cella
      cCash.Add Array(.Value, 0)
    End With
  Next cella

  For Each cella In rng.Offset(, 8)
    With cella
      cPaym.Add Array(.Value, .Offset(0, 1).Value)
    End With
  Next cella


  For k = 1 To cCash.Count
    j = 0
    For Each vPaym In cPaym
      j = j + 1
      If (vPaym(0) = cCash.Item(k)(0)) Then
        cCash.Add Array(cCash(k)(0), vPaym(1)), after:=k
        cCash.Remove k
        cPaym.Remove j
        Exit For
      End If
    Next
  Next k


  For k = 1 To cCash.Count
    If cCash(k)(1) = 0 Then
      nMin = cCash(k)(0) - nToll
      nMax = cCash(k)(0) + nToll
      j = 0
      For Each vPaym In cPaym
        j = j + 1
        If (vPaym(0) >= nMin And vPaym(0) <= nMax) Then
          cCash.Add Array(cCash(k)(0), vPaym(1)), after:=k
          cCash.Remove k
          cPaym.Remove j
          Exit For
        End If
      Next
    End If
  Next k
  
  For j = 1 To cCash.Count
    rng.Cells(j, 1).Offset(0, 7) = cCash(j)(1)
  Next j
  On Error GoTo 0
  'Exit Sub

CheckCash_Error:
  Set wb = Nothing
  Set ws = Nothing
  Set rng = Nothing
  Set cPaym = Nothing
  Set cCash = Nothing
  Application.Calculation = bCalc
  If Err.Number <> 0 Then
    MsgBox "Error: " & Err.Description, vbCritical, "ERRORE"
  End If
End Sub

di totygno71 (utente non iscritto) data: 09/04/2014 08:32:08
Sono parzialmente daccordo con Scossa.
Secondo me la "logica" è assolutamente improponibile: come fate, ad esempio, a stabilire che il 100.000 in H6 corrisponda al 100.000 in P4 anziché al 100.000 in P5?
Oppure: il 100.003 a quale dei due 100.000 dovrebbe corrispondere?

la richiesta di antonella non era questa, ma solo verificare tra i due file se ci fossere similitudini nel dato con uno scarto + o - un certo valore.
Cmq sia protebbe essere che l'ipotesi di scossa apra nuovi scenari al lavoro di antonella...
di Drina - dj2409200 (utente non iscritto) data: 09/04/2014 10:00:01
Buondì ragazzi,

la proposta di Scossa è quella a cui avevo pensato anche io, ma non riuscivo a dare una soluzione.

Ieri sera ho provato la proposta di Totygno71, ma sui grandi numeri non era molto affidabile.

Provo e vi dico ragazzi...grazie di cuore!!!!...serena giornata...antonella

di scossa data: 09/04/2014 13:44:45
Visto chele righe sono tante, meglio velocizzarla sostituendo la collection cCash con un array.

scossa's web site

'---------------------------------------------------------------------------------------
' Procedure : CheckCash
' Author    : scossa
' Date      : 08/04/2014
' Purpose   :
'---------------------------------------------------------------------------------------
'
Public Sub CheckCash()

  Dim wb As Workbook
  Dim ws As Worksheet
  Dim rng As Range
  Dim cella As Range
  Dim cPaym As Collection
  Dim vPaym As Variant
  Dim aCash As Variant
  Dim nMax As Currency
  Dim nMin As Currency
  Dim nToll As Currency
  Dim j As Long
  Dim k As Long
  Dim nRows As Long
  Dim bCalc As XlCalculation
  
  
'  On Error GoTo CheckCash_Error
  
  With Application
    bCalc = .Calculation
    .Calculation = xlCalculationManual
  End With
  Set wb = ThisWorkbook
  Set ws = wb.Worksheets("Foglio1")
  Set rng = ws.Range("H4:H" & ws.Cells(Rows.Count, 8).End(xlUp).Row)
  Set aCash = New Collection
  Set cPaym = New Collection

  nToll = ws.Range("P1").Value
  rng.Offset(, 7).ClearContents
  nRows = rng.Rows.Count
  ReDim aCash(1 To nRows, 1 To 2)
  For k = 1 To nRows
    With rng(k, 1)
      aCash(k, 1) = .Value
      aCash(k, 2) = ""
    End With
  Next k

  For Each cella In rng.Offset(, 8)
    With cella
      cPaym.Add Array(.Value, .Offset(0, 1).Value)
    End With
  Next cella


  For k = 1 To nRows
    j = 0
    For Each vPaym In cPaym
      j = j + 1
      If vPaym(0) = aCash(k, 1) Then
        aCash(k, 1) = vPaym(0)
        aCash(k, 2) = vPaym(1)
        cPaym.Remove j
        Exit For
      End If
    Next
  Next k


  For k = 1 To nRows
    If aCash(k, 2) = "" Then
      nMin = aCash(k, 1) - nToll
      nMax = aCash(k, 1) + nToll
      j = 0
      For Each vPaym In cPaym
        j = j + 1
        If (vPaym(0) >= nMin And vPaym(0) <= nMax) Then
          aCash(k, 1) = vPaym(0)
          aCash(k, 2) = vPaym(1)
          cPaym.Remove j
          Exit For
        End If
      Next
    End If
  Next k
  
  For j = 1 To nRows
    rng.Cells(j, 1).Offset(0, 7) = aCash(j, 2)
  Next j
  On Error GoTo 0
  'Exit Sub

CheckCash_Error:
  Set wb = Nothing
  Set ws = Nothing
  Set rng = Nothing
  Set cPaym = Nothing
  Set aCash = Nothing
  Application.Calculation = bCalc
  If Err.Number <> 0 Then
    MsgBox "Error: " & Err.Description, vbCritical, "ERRORE"
  End If
End Sub

di dj2409200 data: 09/04/2014 15:25:21
Ciao Scossa,

ehm, che dire!!!? sono un'autoditatta e certi termini non li conosco; quindi non so cosa significa quello che stai proponendo. Cosa significa?

Appena finito il mio quotidiano provo la macro; sostituisco quella che hai messo nel messo nel file con quella che hai postato prima?

Grazie ancora...anto

di scossa data: 09/04/2014 16:44:18
cit.: "sostituisco quella che hai messo nel messo nel file con quella che hai postato prima?"

Sì!

scossa's web site

di dj2409200 data: 10/04/2014 11:47:21
Ciao ragazzi,

FUNZIONA!!!!!!!!!!!!!

Vi ringrazio di cuore e vi mando una torta viruale al cioccolatino!!!!!!

A presto........serena giornata a tutti!!!!!!......antonella
di dj2409200 data: 10/04/2014 12:17:50

Vuoi Approfondire?