confrontare due colonne di valori numerici non univoci

Question

Salve a tutti  

avrei bisogno di confrontare due colonne A e B di valori numerici non univoci (riconciliazione bancaria) e trovare le differenze..

ho provato l'esempio del supporto:

Sub Find_Matches()
    Dim CompareRange As Variant, x As Variant, y As Variant
    ' Set CompareRange equal to the range to which you will
    ' compare the selection.
    Set CompareRange = Range("C1:C5")
    ' NOTE: If the compare range is located on another workbook
    ' or worksheet, use the following syntax.
    ' Set CompareRange = Workbooks("Book2"). _
    '   Worksheets("Sheet2").Range("C1:C5")
    '
    ' Loop through each cell in the selection and compare it to
    ' each cell in CompareRange.
    For Each x In Selection
        For Each y In CompareRange
            If x = y Then x.Offset(0, 1) = x
        Next y
    Next x
End Sub

 ma non è efficace con i dati ripetitivi .. ( non  basterebbe cancellare i dati corrispondenti nelle due colonne e passare al successivo confronto???  . Alla fine rimarrebbero solo le celle con i dati non corrispondenti) .

Grazie

Answer 1

Ciao Carlo,

GRAZIE NORMAN! MITICO!..... sembrerebbe funzionare l'ho testato su un elenco di circa 100 voci abbastanza omogenee ( ho preso un elenco e l'ho duplicato con qualche cambiamento) ed è OK . Grazie alla tua SUB il lavoro di 8 ore lo riduco ad 1 (solo il tempo di importare i dati contabili)  ........ nei prossimi giorni lo testero con dati reali....

 Vorrei ringraziarti per il cortese riscontro che è molto apprezzato.

Credo che il codice suggerito debba funzionare indipendentemente dalle dimensioni o le posizioni dei due intervalli di interesse.

Se i tuoi test  esaustivi  dovrebbero  confermare questa ipotesi, vorrei gentilmente chiederti di contrassegnare la risposta rilevante come Risposta. In questo modo, tu aiuterai anche coloro che potrebbero cercare soluzioni ai problemi simili negli archivi della comunità.

===

Regards,

Norman

Answer 2

GRAZIE NORMAN! MITICO!..... sembrerebbe funzionare l'ho testato su un elenco di circa 100 voci abbastanza omogenee ( ho preso un elenco e l'ho duplicato con qualche cambiamento) ed è OK . Grazie alla tua SUB il lavoro di 8 ore lo riduco ad 1 (solo il tempo di importare i dati contabili)  ........ nei prossimi giorni lo testero con dati reali....

Answer 3

Ciao Carlo,

Poiché si può utilizzare il metodo Union solo per intervalli sullo stesso foglio, meglio e più robusta sarebbe la seguente versione:

'=========>>

Option Explicit

'--------->>

Public Sub RiconciliazioneConPistaDiControllo ()

    Dim CompareWB As Workbook, CompareToWB As Workbook

    Dim CompareToSH As Worksheet, CompareSH As Worksheet

    Dim CompareToRange As Range, CompareRange As Range

    Dim x As Range, y As Range

    Dim i As Long

    Const sCompareRange As String = "C1:C100"                             '<<=== Modifica

    Const sCompareToRange As String ="D1:D50"                           '<<=== Modifica

    Set CompareWB = Workbooks("Carlo1.xlsm")                             '<<=== Modifica

    Set CompareToWB = Workbooks("Carlo2.xlsm")                         '<<=== Modifica

    Set CompareSH = CompareWB.Sheets("Foglio1")  '<<=== Modifica

    Set CompareToSH = CompareToWB.Sheets("Foglio2")                 '<<=== Modifica

    Set CompareRange = CompareSH.Range(sCompareRange)

    Set CompareToRange = CompareToSH.Range(sCompareToRange)

    CompareRange.EntireColumn.Offset(0, 1).Insert

    CompareToRange.EntireColumn.Offset(0, 1).Insert

    For Each x In CompareToRange.Cells

        For Each y In CompareRange.Cells

            If x.Value <> vbNullString _

               And x.Value = y.Value _

               And y.Offset(0, 1) = vbNullString Then

                i = i + 1

                With x

                    .Font.Strikethrough = True

                    .Offset(0, 1) = i

                End With

                With y

                    .Font.Strikethrough = True

                    .Offset(0, 1) = i

                End With

                Exit For

            End If

        Next y

    Next x

End Sub

'<<=========

===

Regards,

Norman

Answer 4

Ciao Carlo,

Prova qualcosa del genere:

'=========>>

Option Explicit

'--------->>

Public Sub RiconciliazioneConPistaDiControllo ()

    Dim CompareWB As Workbook, CompareToWB As Workbook

    Dim CompareToSH As Worksheet, CompareSH As Worksheet

    Dim CompareToRange As Range, CompareRange As Range

    Dim x As Range, y As Range

    Dim i As Long

    Const sCompareRange As String = "C1:C100"                             '<<=== Modifica

    Const sCompareToRange As String = "D1:D50"                           '<<=== Modifica

    Set CompareWB = Workbooks("Carlo1.xlsm")                             '<<=== Modifica

    Set CompareToWB = Workbooks("Carlo2.xlsm")                         '<<=== Modifica

    Set CompareSH = CompareWB.Sheets("Foglio1")  '<<=== Modifica

    Set CompareToSH = CompareToWB.Sheets("Foglio2")                 '<<=== Modifica

    Set CompareRange = CompareSH.Range(sCompareRange)

    Set CompareToRange = CompareToSH.Range(sCompareToRange)

    CompareRange.EntireColumn.Offset(0, 1).Insert

    CompareToRange.EntireColumn.Offset(0, 1).Insert

    For Each x In CompareToRange.Cells

        For Each y In CompareRange.Cells

            If x.Value <> vbNullString _

               And x.Value = y.Value _

               And y.Offset(0, 1) = vbNullString Then

                i = i + 1

                With Union(x, y)

                    .Offset(0, 1) = i

                    .Font.Strikethrough = True

                End With

                Exit For

            End If

        Next y

    Next x

End Sub

'<<=========

===

Regards,

Norman