[VBA] Comparazione spreadsheets e colore celle

[cerebrolele]

Ciao a tutti,

sto usando una macro VBA in MS Excel (2007) che mi permette di comparare due tabelle.

Una delle funzioni e' quella di copiare i records con delle differenze in un differente foglio di lavoro, colorando la rispettiva cella modificata in rosso.

Lo script funziona bene nel caso di cambio di informazioni, ma quando una cella viene modificata e il nuovo valore e' nullo (cella vuota), mi risulta colorata in rosso la cella al di sopra di quella interessata invece che quella corretta.

Ecco qui sotto lo script. Qualche idea su dove sbaglio?

Sub GDV()
    Dim WsA As Worksheet, WsB As Worksheet, WsC As Worksheet, WsD As Worksheet, WsE As Worksheet
    Dim rFind As Range, c As Range
    Dim I As Integer, ColCnt As Integer
     
    Set WsA = Worksheets("OldExport")
    Set WsB = Worksheets("NewExport")
    Set WsC = Worksheets("Changes")
    Set WsD = Worksheets("PosDeleted")
    Set WsE = Worksheets("PosAdded")
     
    ColCnt = WsA.Cells(1, Columns.Count).End(xlToLeft).Column
     
    With CreateObject("Scripting.Dictionary")
        For Each c In WsA.Range("A2", WsA.Range("A" & Rows.Count).End(xlUp))
            If Not .exists(c.Value) Then
                .Add c.Value, False
                Set rFind = WsB.Columns(1).Find(What:=c.Value, LookIn:=xlValues)
                If Not rFind Is Nothing Then
                    For I = 1 To ColCnt
                        If Not c.Offset(, I - 1) = WsB.Cells(rFind.Row, I) Then
                            If .Item(c.Value) = False Then
                                rFind.Resize(1, ColCnt).Copy WsC.Range("A" & Rows.Count).End(xlUp).Offset(1)
                                .Item(c.Value) = True
                            End If
                            WsC.Cells(Rows.Count, I).End(xlUp).Interior.ColorIndex = 3
                        End If
                    Next I
                Else
                    MsgBox c.Value & " PosID has been canceled!"
                    c.Resize(1, ColCnt).Copy WsD.Range("A" & Rows.Count).End(xlUp).Offset(1)
                End If
            End If
        Next c
        For Each c In WsB.Range("A2", WsB.Range("A" & Rows.Count).End(xlUp))
            If Not .exists(c.Value) Then
                MsgBox c.Value & " PosID has been added!"
                c.Resize(1, ColCnt).Copy WsE.Range("A" & Rows.Count).End(xlUp).Offset(1)
            End If
        Next c
    End With
End Sub

[cerebrolele]

mi rispondo da solo per chi avesse un problema simile...

ho trovato una soluzione semplice e rapida

e' bastato sostituire nelle tabelle da comparare (find/replace) ogni cella vuota con un carattere (slash) ed il gioco e' fatto! niente piu bug!