MacroFacili: Confronto fra elenchi di valori

Un problema che si presenta spesso nel lavoro quotidiano è quello di confrontare due elenchi di valori, dei fatturati ad esempio. E' un "problema" che di solito si risolve utilizzando il cerca verticale su entrambi gli elenchi e poi unendo le differenze

Questo file consente di farlo in modo molto semplice: si incollano i due elenchi di dati, anche molto lunghi, da confrontare e la macro evidenzia un elenco con le sole differenze fra i due.

Nell'immagine a lato (la stessa dell'esempio che si può scaricare in basso in questa pagina) si vede il risultato del funzionamento.

La macro fa il confronto a parità di codice ed evidenzia:

I codici con valori diversi;
I valori presenti nel primo elenco e non nel secondo;
I valori presenti nel secondo elenco ma non nel primo.

Il confronto viene fatto sul singolo valore, ma sono sufficienti poche modifiche al codice per fare il confronto di 2 o più valori.

l'esempio completo é scaricabile da questo link: Es459.xlsm (a questo link le info per attivare le macro se risultano bloccate)

Il codice della macro:

Sub Confronta()
  Set Fi1 = Sheets("Elenco1")
  Set Fi2 = Sheets("Elenco2")
  Set Fa = Sheets("Confronto")
  ScartoMinimo = 1

  R_Formati = 5
  R_InizDati = 10
  C_Iniziale = 2
  C_Finale = C_Iniziale + 4

  Dim Dati As New Collection
  Dim Dt As ClDati

  '--- Cancella le righe compilate in precedenza ---
  Fa.Activate
  Rf = Cells(Rows.Count, C_Iniziale).End(xlUp).Row
  If (Rf > R_InizDati) Then
    Rows(R_InizDati & ":" & Rf).Delete Shift:=xlUp
  End If

  '--- Legge da Elenco 1 ---
  Ri = 2
  While (Fi1.Cells(Ri, "A") <> "")
    Codice = Fi1.Cells(Ri, 1)
    If (IsNumeric(Codice)) Then Codice = Trim(Str(Codice))

    If (Not (InCollection(Dati, Codice))) Then
      Set Dt = New ClDati
      Dt.Codice = Fi1.Cells(Ri, "A")
      Dt.Descrizione = Fi1.Cells(Ri, "B")
      Dt.Valore1 = Fi1.Cells(Ri, "C")
      Dati.Add Item:=Dt, Key:=Codice
      Set Dt = Nothing
    Else
      Dati(Codice).Valore1 = Dati(Codice).Valore1 + Fi1.Cells(Ri, "C")
    End If

    Ri = Ri + 1
  Wend

  '--- Legge da Elenco 2 ---
  Ri = 2
  While (Fi2.Cells(Ri, "A") <> "")
    Codice = Fi2.Cells(Ri, 1)
    If (IsNumeric(Codice)) Then Codice = Trim(Str(Codice))

    If (Not (InCollection(Dati, Codice))) Then
      Set Dt = New ClDati
      Dt.Codice = Fi2.Cells(Ri, "A")
      Dt.Descrizione = Fi2.Cells(Ri, "B")
      Dt.Valore2 = Fi2.Cells(Ri, "C")
      Dati.Add Item:=Dt, Key:=Codice
      Set Dt = Nothing
    Else
      Dati(Codice).Valore2 = Dati(Codice).Valore2 + Fi2.Cells(Ri, "C")
    End If

    Ri = Ri + 1
  Wend
  R_FineDati = Ra - 1

  '--- Riporta le righe con valori differenti ---
  Ra = R_InizDati
  For Each Dato In Dati
    If (Abs(Dato.Valore1 - Dato.Valore2) > ScartoMinimo) Then
      Fa.Cells(Ra, C_Iniziale + 0) = Dato.Codice
      Fa.Cells(Ra, C_Iniziale + 1) = Dato.Descrizione
      Fa.Cells(Ra, C_Iniziale + 2) = Dato.Valore1
      Fa.Cells(Ra, C_Iniziale + 3) = Dato.Valore2
      Ra = Ra + 1
    End If
  Next
  R_FineDati = Ra - 1

  '--- Formattazione: copia il formato dalla riga R_Formati ---
  Fa.Rows(R_Formati).Copy
  Fa.Range(Rows(R_InizDati), Rows(R_FineDati)).Select
  Selection.PasteSpecial Paste:=xlPasteFormats
  Selection.EntireRow.Hidden = False
  Selection.EntireRow.Ungroup

  '--- Formule: copia le formule dalla riga R_Formati ---
  For C = C_Iniziale To C_Finale
    If (Fa.Cells(R_Formati, C).HasFormula) Then
      Fa.Cells(R_Formati, C).Copy
      Fa.Range(Fa.Cells(R_InizDati, C), Fa.Cells(R_FineDati, C)).Select
      Selection.PasteSpecial Paste:=xlPasteFormulas
    End If
  Next C
End Sub

La classe che contiene i dati:

Public Codice As String
Public Descrizione As String
Public Valore1 As Double
Public Valore2 As Double

Gli esempi contenuti nel sito sono per uso personale, non é consentito l'uso professionale, commerciale o la riproduzione senza autorizzazione.

Per dubbi o domande potete scriverci a domande@macrofacili.it, sulla nostra pagina FB MacroFacili.it o sul gruppo FB Excel, macro e formule.