identificare i duplicati di una tabella

[Final Job]

Buongiorno.
Se possibile, avrei bisogno del vostro aiuto in quanto l'importanza del
controllo che devo fare e alcune particolarità dello scenario che
descrivo qui di seguito necessitano un'esperienza che io ancora non ho.

Nella colonna U del foglio "Articoli" ho una lista di codici.

I dati iniziano dalla riga 6.

I codici sono alfanumerici e possono contenere separatori di varia
natura (- . : ecc).

Alcuni articoli non presentano codici quindi la colonna U presenta dei
vuoti.

Per valutare l'estensione della tabella io uso la colonna AB.



Ho bisogno di segnalare i codici che sono presenti nella colonna U due o
più volte.

L'argomento è stato già trattato ma in questo caso servirebbero un paio
di elementi che diversificano questa soluzione dalle precedenti.

Le segnalazioni dei duplicati devono trovare posto nella colonna R dello
stesso foglio assegnando progressivamente a tutti i codici che hanno dei
doppioni uno stesso numero (Es. 1 a tutti i doppioni trovati per primi
nella scansione, 2 a quelli trovati per secondi e così via). Questa
semplice soluzione mi consente di ordinare successivamente il foglio
proprio secondo la colonna R e valutare con più facilità tali situazioni
(che sono anomale) raggruppando i codici interessati.

Se la cella Q5 del foglio "Istruzioni" è smarcata la comparazione dei
codici avviene Case Sensitive.

Se la cella Q5 del foglio "Istruzioni" NON è smarcata la comparazione
dei codici avviene NON Case Sensitive.

Grazie per gli eventuali suggerimenti
Ale

[casanmaner]

Ciao Ale non garantisco che abbia molto tempo :-)
Ma una domanda te la faccio.
Lo schema è come quello dell'altro file?
Foglio Confronto? Foglio OriginaleFornitore?
O si tratta di altro schema?

[Final Job]

Ciao Casamnamer
si , il lavoro è una struttura identica al foglio che già conosci. I
fogli sono intitolati diversamente ma le colonne sono le stesse. Io,
però, vorrei sviluppare una sub autonoma da utilizzare chiamandola
quando necessario. La dovrei adattare anche per altri fogli.

Sapevo già che eri impegnato ... non ti preoccupare in qualche modo farò.
Buon lavoro
Ale

[casanmaner]

Ciao Ale,
prova questo file di test e vedi se fa quello che chiedi.
Questo il link:
https://www.dropbox.com/s/qx3a2lasek1t0ee/identificare%20i%20duplicati%20di%20una%20tabella.xls?dl=0

Questo il codice dove è presente la precedente funzione per verificare il metodo di comparazione e una nuova procedura che dovrebbe assegnare un numero identico ad ogni duplicato (partendo dal primo duplicato che viene incontrato e aumentandolo progressivamente di fronte a ciascun successivo duplicato) e non ai codici "singoli" o agli spazi vuoti presenti nella colonna dei codici.
'---
Option Explicit

Public Function fCompareMode() As Long
'<--- funzione che imposta il metodo di comparazione del testo --->
Dim Wb As Workbook
Dim WsIstruzioni As Worksheet
Dim rngCompareMode As Range
Set Wb = ThisWorkbook
Set WsIstruzioni = Wb.Worksheets("Istruzioni")
Set rngCompareMode = WsIstruzioni.Range("Q5")
If rngCompareMode = True Then
fCompareMode = vbBinaryCompare 'Case Sensitive
Else
fCompareMode = vbTextCompare 'Non Case Sensitive
End If
Set Wb = Nothing
Set WsIstruzioni = Nothing
Set rngCompareMode = Nothing
End Function

Sub NumeraDuplicati()

Const sWsName As String = "Articoli" 'nome foglio articoli
Const HeadRow As Long = 5 'numero riga dove sono presenti le intestazioni di colonna
Const sRngCodArt As String = "U" 'lettera colonna dove sono presenti i codici degli articoli
Const sRngLastRow As String = "AB" 'lettera colonna dove rilevare l'ultimo record
Const sRngColNum As String = "R" 'lettera colonna dove inserire i numeri dei duplicati
Const chrSeparatore As String = "," 'carattere che unisce le righe in cui si trovano i codici articolo rispetto alla matrice

Dim Twb As Workbook
Dim WsArticoli As Worksheet
Dim RngFirstRow As Range
Dim RngLastRow As Range
Dim RngFirstCodArt As Range
Dim RngLastCodArt As Range
Dim rngColNum As Range
Dim ArrayDatiArt() As Variant
Dim ArrayNumDupl() As Variant
Dim i As Long
Dim dictDatiArt As Object
Dim dictObj As Variant
Dim ArrayRigheDupl As Variant
Dim OptCompareMode As Long
Dim valCodArt As Variant
Dim Cont As Long

Set Twb = ThisWorkbook
Set WsArticoli = Twb.Worksheets(sWsName)
With WsArticoli
Set RngFirstRow = .Range(sRngLastRow & HeadRow)
Set RngLastRow = .Range(sRngLastRow & .Cells(.Rows.Count, sRngLastRow).End(xlUp).Row)
If RngLastRow.Row - RngFirstRow.Row <= 1 Then Exit Sub
Set RngFirstCodArt = .Range(sRngCodArt & RngFirstRow.Offset(1).Row)
Set RngLastCodArt = .Range(sRngCodArt & RngLastRow.Row)
Set rngColNum = .Range(.Range(sRngColNum & RngFirstRow.Offset(1).Row), .Range(sRngColNum & RngLastRow.Row))
ArrayDatiArt = .Range(RngFirstCodArt, RngLastCodArt).Value
End With

ReDim ArrayNumDupl(LBound(ArrayDatiArt, 1) To UBound(ArrayDatiArt, 1), 1 To 1)

OptCompareMode = fCompareMode

Set dictDatiArt = CreateObject("Scripting.Dictionary")
dictDatiArt.CompareMode = OptCompareMode

For i = LBound(ArrayDatiArt, 1) To UBound(ArrayDatiArt, 1)
If OptCompareMode = vbBinaryCompare Then
valCodArt = ArrayDatiArt(i, 1)
ElseIf OptCompareMode = vbTextCompare Then
valCodArt = UCase(ArrayDatiArt(i, 1))
End If
If Not dictDatiArt.Exists(valCodArt) Then
dictDatiArt.Add valCodArt, i
Else
dictDatiArt(valCodArt) = dictDatiArt(valCodArt) & chrSeparatore & i
End If
Next i

Cont = 0
For Each dictObj In dictDatiArt.Keys
If dictObj <> "" Then
If UBound(Split(dictDatiArt(dictObj), chrSeparatore)) Then
Cont = Cont + 1
ArrayRigheDupl = Split(dictDatiArt(dictObj), chrSeparatore)
For i = LBound(ArrayRigheDupl) To UBound(ArrayRigheDupl)
ArrayNumDupl(CLng(ArrayRigheDupl(i)), 1) = Cont
Next i
End If
End If
Next dictObj

With WsArticoli
'.Unprotect
rngColNum.Value = (ArrayNumDupl)
'.Protect
End With
End Sub
'---

Spero riesca nell'intento ma lascio a te le verifiche più approfondite in base al tuo reale DB.

ciao

[casanmaner]

In questa riga:
   If UBound(Split(dictDatiArt(dictObj), chrSeparatore)) Then 

Volevo indicare > 1 anche se incidentalmente dovrebbe funzionare ugualmente perché se il limite inferiore della matrice è zero la condizione corrisponde a falso.
Ma sarebbe da correggere.
Domani correggo il file.

[Final Job]

Mi pare che funzioni bene ....mi facilita molto le cose questa soluzione.

Ho visto anche io che la struttura è simile a quella della sub Estrai.

Stavo provando a risolvere con un contatore da incrementare ad ogni
nuovo codice da "spazzolare" ma non avrei mai potuto produrre nulla di
tale sintesi e velocità.

Spero di non averti fatto perdere troppo tempo e sonno.
Grazie mille
Ale

[Final Job]

e infatti funzionava anche così
Tranquillo
correggo io, non serve altro

grazie di nuovo e buona notte
Ale

[Final Job]

magari, se hai due minuti nei prossimi giorni, mi dici brevemente a cosa
serve questo passo?

Const chrSeparatore As String = ","

Ale

Il 16/03/2017 00:21, casanmaner ha scritto:

[casanmaner]

Devo ricorreggere la precedente.
Certe cose vanno scritte a mente sveglia :-)
La condizione deve essere ">0" o, in alternativa ">=1".
Questo perché la matrice che si forma utilizzando SPLIT è una matrice base zero.
Quindi la dimensione massima dà come risultato zero se è presente un solo elemento (e ieri sera, mentre indicavo la correzione, ho ragionato in termini di elementi presenti nella matrice.

Per quanto riguarda la dichiarazione della costante:

Const chrSeparatore As String = ","

Ho semplicemente fatto così in modo che poi nelle successive righe di comando invece di indicare direttamente "," ho indicato il testo della costante.
In tal modo, per qualsiasi motivo, si desideri modificare il carattere che separa i numeri di riga che man mano vengono concatenati quando viene trovato un codice duplicato, non c'è poi bisogno di andarlo a modificare in tutte le righe.
Tieni presente che in questa parte delle istruzioni:
----

If Not dictDatiArt.Exists(valCodArt) Then
dictDatiArt.Add valCodArt, i
Else
dictDatiArt(valCodArt) = dictDatiArt(valCodArt) & chrSeparatore & i
End If

----

quando trovo il primo codice di articolo assegno alla "chiave" della dictionari, data dal testo del codice articolo, come valore l'indice del ciclo (che in questo caso va da 1 fino al numero di record presenti nell'intervallo dei dati). Se poi viene trovato un ulteriore codice identico, in base anche al metodo di comparazione, alla stessa chiave già creata assegno come valore l'indice immediatamente precedente, il carattere separatore, e l'indice del codice trovato duplicato.
Es. se ho il codice AAA1 nella prima riga dell'intervallo, poi nella decima riga e poi nella centesima riga creo un testo concatenato uguale a "1,10,100".

Nella fase successiva per ogni chiave della dictionari (che corrisponde ad un codice articolo univoco) verifico, splittando il valore in base al carattere separatore, se per quella chiave sono presenti più numeri di riga e assegno ad una matrice, che ha la stessa dimensione di righe dell'intervallo dati, un contatore "Cont" che man mano viene incrementato solo se la chiave della dictionary ha più di un elemento (o se la chiave non rappresenta un valore vuoto che in realtà potrebbe essere evitato già nella fase precedente).

[Final Job]

non saprei imbastire autonomamente un progetto costruito così come hai
fatto tu ma ho compreso molte delle cose che hai meticolosamente
spiegato compresa la filosofia per l'uso del separatore

Grazie di nuovo, soprattutto del tempo speso in questo tuo laborioso
periodo.
Ale