Analizzare un range di celle e verificare se è assente un dato presente nel 2 foglio di lavoro e visualizzarlo in un MSGBOX

Question

Buongiorno a tutti gli amici della community.

Per operazioni lavorative che hanno cadenza mensile, ho la necessità di verificare, al momento del trasferimento dei dati tramite la finestra Filedialog se in una colonna non sono presenti dei codice numerici (nel mio caso specifico solo tre cifre es. 860,720 ecc.) rispetto agli stessi dati fissi riportati nel Foglio DATI ( alla colonnaA) del file che allego per prova.

Cioè dovrebbe accadere questo:

Il codice VBA ( magari lanciato da pulsante di comando) dovrebbe verificare le due colonne ( colonna B del Foglio 1 e colonna A del foglio DAT) e tramite MSGBOX annunciarmi il codice di tre cifre mancante.

Si tenga presente, però, che nel foglio 1 nella colonna B ci sono gli stessi codici ripetuti per più volte ( indicano tate persone che hanno quel tipo di ritenuta mensile es. tanti 930, 870 ecc.) e nel momento in cui il codice VBA  rilevi un dato diverso rispetto alla colonna A del foglio DATI  il MSGBOX dovrebbe dire che è assente solo il tipo di codice es. 930, 870 ecc. e non che sono assenti nr. 50 codici 930, 25 codici  870 ecc.

Quindi, per essere chiaro, il MSGBOX deve indicare solo il codice di tre cifre che è assente nel foglio DATI in colonna A e non il numero totale dei codici assenti.

Spero di essere stato chiaro e comprensibile.

Ringrazio anticipatamente tutti coloro che vorranno aiutarmi in questo.

Il link dove ho pubblicato il file è questo:http://1drv.ms/1EwhB95

Ciao Nicola.

Answer 1

Ciao Nicola, 

Per una maggiore flessibilità, sostituisci

    Call MsgBox(Prompt:="I codici mancanti nel foglio Dati sono:" _

                      & vbNewLine & vbNewLine _

                      & sStr, Buttons:=vbInformation, Title:="ELENCO NICOLA")

con:

    Call MsgBox(Prompt:="I codici mancanti nel foglio " & dataSH.Name & " sono:" _

                      & vbNewLine & vbNewLine _

                      & sStr, Buttons:=vbInformation, Title:="ELENCO NICOLA")

===

Regards,

Norman

Answer 2

Ciao nichicanta,

ho preparato **questo**ma dopo aver letto la questione del colore, di cui non mi pare vi sia cenno nel tuo primo post di questo thread, non so più se va bene.

Per eseguire:

1. ALT+F8
2. Nome macro:

Test 3. [ Esegui ]

Answer 3

Ciao Nicola,

Prova qualcosa del genere:

• Alt-F11 per aprire l'editor di VBA
• Alt-IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

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

Option Explicit

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

Public Sub Tester()

    Dim WB As Workbook

    Dim srcSH As Worksheet, dataSH As Worksheet

    Dim srcRng As Range, dataRng As Range

    Dim rCell As Range, aCell As Range

    Dim oDic As Object, oDic2 As Object

    Dim arrKeys As Variant, arrOut() As Variant

    Dim iRow As Long, jRow As Long

    Dim i As Long, j As Long, k As Long

    Dim sStr As String

    Const sColonna As String = "B"                              '<<===== Modifica

    Set WB = ActiveWorkbook

    With WB

        Set srcSH = .Sheets("Foglio1")                         '<<===== Modifica

        Set dataSH = .Sheets("Dati")                              '<<===== Modifica

    End With

    With srcSH

        iRow = LastRow(srcSH, .Columns("A:A"))

        Set srcRng = .Range(sColonna & "2:" & sColonna & iRow)

    End With

    With dataSH

        jRow = LastRow(dataSH, .Columns("A:A"))

        Set dataRng = .Range("A2:A" & jRow)

    End With

    Set oDic = CreateObject("Scripting.Dictionary")

    Set oDic2 = CreateObject("Scripting.Dictionary")

    oDic.CompareMode = vbTextCompare

    oDic2.CompareMode = vbTextCompare

    On Error Resume Next

    For Each rCell In srcRng.Cells

        With rCell

            oDic.Add Item:=vbNullString, Key:=.Value

        End With

    Next rCell

    For Each aCell In dataRng.Cells

        With aCell

            oDic2.Add Item:=aCell.Row, Key:=.Value

        End With

    Next aCell

    On Error GoTo 0

    arrKeys = oDic.keys

    For i = LBound(arrKeys) To UBound(arrKeys)

        If Not oDic2.exists(arrKeys(i)) Then

            j = j + 1

            ReDim Preserve arrOut(1 To j)

            arrOut(j) = arrKeys(i)

        End If

    Next i

    sStr = Join(arrOut, vbNewLine)

    Call MsgBox(Prompt:="I codici mancanti nel foglio Dati sono:" _

                      & vbNewLine & vbNewLine _

                      & sStr, Buttons:=vbInformation, Title:="ELENCO NICOLA")

XIT:

    Set oDic = Nothing

    Set oDic2 = Nothing

End Sub

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

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

End Function

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

• Alt-Q per chiudere l'editor di VBA e tornare a Excel.
• Alt-F8 per aprire  la finestra di gestione delle macro
• Seleziona Tester | Esegui

===

Regards,

Norman

Answer 4

Ciao Norman. grazie come sempre per il tuo prezioso intervento.

Il numero dei codici mancanti può variare rispetto al mese precedente è può essere anche più di 1.

Io a dire il vero stavo impostando (ci provo perchè ho tanta voglia di imparare e fare da solo) il codice per la mia esigenza in questo modo scopiazzando qua e la in rete il codice che posto e che è anche frutto del grande Mauro Gamberini ( che saluto con grande affetto estima), però mi sono bloccato su come analizzare il dato di colore diverso e visulizzarlo in un MSGBOX al fine di riconoscerlo codiec mancante.

Penso che sia macchinoso, ma ci volevo provare.

Con questo copio i dati per il confronto:

Public Sub m_1()

    'dichiaro le variabili

    Dim lRiga As Long

    Dim sh1 As Worksheet

    Dim sh2 As Worksheet

    Dim lng As Long

    'metto un riferimento al Foglio1

    Set sh1 = ThisWorkbook.Worksheets("Foglio1")

    'creo un nuovo foglio che utilizzerò per incollare

    'i dati univoci e metto un riferimento allo stesso

'Set sh2 = ThisWorkbook.Worksheets.Add

    Set sh2 = ThisWorkbook.Worksheets("Foglio2")

    'impedisco lo sfarfallio del monitor

    Application.ScreenUpdating = False

    With sh1

        'trovo l'ultima riga con valori della colonna A

        'del Foglio1

        lRiga = .Range("B" & Rows.Count).End(xlUp).Row

        'filtro la colonna A del Foglio1 in modo da

        'avere valori univoci in colonna A del foglio di appoggio

        .Range("B1:B" & lRiga).AdvancedFilter _

            Action:=xlFilterCopy, _

            CopyToRange:=sh2.Range("B1"), Unique:=True

        'trovo l'ultima riga con valori della colonna A

        'del foglio di appoggio

        lRiga = sh2.Range("B" & sh2.Rows.Count).End(xlUp).Row

        'ciclo la colonna A del foglio di appoggio e carico i valori

        'nella ComboBox1

        For lng = 2 To lRiga

            UserForm1.ComboBox1.AddItem (sh2.Range("B" & lng).Value)

        Next

        'elimino il foglio di appoggio creato disbilitando la richiesta

        'di conferma e ripristino l'aggiornamento del monitor

       With Application

            .DisplayAlerts = False

            'sh2.Delete

            .DisplayAlerts = True

        End With

    End With

    'Set a Nothing delle variabili oggetto

    Set sh1 = Nothing

    Set sh2 = Nothing

End Sub

con quest'altro evidenzio le differenze:

Sub Formattazione()

Dim n As Long, i As Long, LastRow As Long

Dim Foglio As Worksheet, Range1 As Range

Set Foglio = Sheets(1)

LastRow = Foglio.UsedRange.Rows.Count

With Foglio

Set Range1 = .Range("A1:B" & LastRow)

              Range1.Interior.ColorIndex = xlNone

For i = 1 To LastRow

 For n = 1 To LastRow

     If .Cells(n, 2).Value = .Cells(i, 1).Value Then

     .Cells(n, 2).Interior.ColorIndex = 3

     .Cells(i, 1).Interior.ColorIndex = 6

  End If

   Next n

Next i

End With

Set Foglio = Nothing

Set Range1 = Nothing

End Sub

Ti ringrazio  e ti saluto, attendo altre tue notizie Norman.

Answer 5

Ciao Nicola,

Ci sono sempre tre codici mancanti o possa variare questo numero di mese in mese? Non dovrebbero essere riportati tutti i codici mancanti?

===

Regards,

Norman