Estrarre solo singolarità

Post by Bruno Campanini
Si potrà costruire una formula capace di estrarre da un range
solo le singolarità (i doppioni vengono ignorati)?

si può, ma perché farlo quando c'è la worksheet function apposita?

Bruno Campanini

2024-03-17 14:34:14 UTC

Post by Bruno Campanini
Si potrà costruire una formula capace di estrarre da un range
solo le singolarità (i doppioni vengono ignorati)?

si può, ma perché farlo quando c'è la worksheet function apposita?

Io con le WorksheetFunction sono rimasto piuttosto indietro.

Bruno

issdr

2024-03-17 18:31:38 UTC

Post by Bruno Campanini
Si potrà costruire una formula capace di estrarre da un range
solo le singolarità (i doppioni vengono ignorati)?

si può, ma perché farlo quando c'è la worksheet function apposita?

Io con le WorksheetFunction sono rimasto piuttosto indietro.

vedi l'esempio che ho postato. la puoi usare anche da VBA, ho fatto
passare qualcosa anche in questo gruppo.

casanmaner

2024-03-17 13:59:39 UTC

Post by Bruno Campanini
Si potrà costruire una formula capace di estrarre da un range
solo le singolarità (i doppioni vengono ignorati)?
In codice, con Query o Dictionary, è cosa facile.
Con Collection, quindi con le sole armi di Excel,
non ci sono riuscito.
Bruno

Ciao Bruno,
con Excel 2021 dovresti avere la funzione filtro.
Con questa io ho estratto i soli valori per cui non siano presenti
duplicati:

=FILTRO(SE((CONTA.SE($A$2:$A$1002;$A$2:$A$1002)=1);$A$2:$A$1002;"");SE((CONTA.SE($A$2:$A$1002;$A$2:$A$1002)=1);$A$2:$A$1002;"")<>"")

Loading Image...

casanmaner

2024-03-17 14:01:28 UTC

Ciao Bruno,
con Excel 2021 dovresti avere la funzione filtro.
Con questa io ho estratto i soli valori per cui non siano presenti
=FILTRO(SE((CONTA.SE($A$2:$A$1002;$A$2:$A$1002)=1);$A$2:$A$1002;"");SE((CONTA.SE($A$2:$A$1002;$A$2:$A$1002)=1);$A$2:$A$1002;"")<>"")
https://www.dropbox.com/scl/fi/xmkaqh3r8p5qut4h66m84/Screenshot-2024-03-17-14.58.29.png?rlkey=cqj8ucp10guiw5n1clw4z4nb6&dl=0

Ancora più semplice in realtà:

=FILTRO(A2:A1002;CONTA.SE(A2:A1002;A2:A1002)=1)

Bruno Campanini

2024-03-17 14:32:15 UTC

=FILTRO(A2:A1002;CONTA.SE(A2:A1002;A2:A1002)=1)

Perfetto! a casa mia:
=FILTER(A1:A13,COUNTIF(A1:A13,A1:A13)=1)

Ma l'appetito vien mangiando:
debbo trovare le singolarità di ciascuna coppia (Ax & "|" & Bx)
per x che va da 1 a 13.

Bruno

casanmaner

2024-03-17 14:55:20 UTC

=FILTRO(A2:A1002;CONTA.SE(A2:A1002;A2:A1002)=1)

=FILTER(A1:A13,COUNTIF(A1:A13,A1:A13)=1)
debbo trovare le singolarità di ciascuna coppia (Ax & "|" & Bx)
per x che va da 1 a 13.
Bruno

Non ho ben inteso.
Intendi che tu hai delle strighe di testo come queste:
A1|B1
A1|B2
A1|B3

e vorresti estrarre le singolarità per la parte di stringa a sinistra e
a destra di "|" (che sarebbe un separatore)?

Bruno Campanini

2024-03-17 15:04:59 UTC

=FILTRO(A2:A1002;CONTA.SE(A2:A1002;A2:A1002)=1)

=FILTER(A1:A13,COUNTIF(A1:A13,A1:A13)=1)
debbo trovare le singolarità di ciascuna coppia (Ax & "|" & Bx)
per x che va da 1 a 13.
Bruno

Non ho ben inteso.
A1|B1
A1|B2
A1|B3
e vorresti estrarre le singolarità per la parte di stringa a sinistra e a
destra di "|" (che sarebbe un separatore)?

Range A1:B13:
AACC Saponetta
ABAA Saponetta
ABAA Saponetta
BCCA Carta Igienica
BCCA Carta Igienica
CABA Dentifricio
CBBA Dentifricio
CBBA Dentifricio
CCCA Saponetta
CCCA Saponetta
ZZZZ Caccona
ZZZ2 Cose varie
ZZZZ Cacca

Risultato:
AACC|Saponetta
CABA|Dentifricio
ZZZZ|Caccona
ZZZ2|Cose varie
ZZZZ|Cacca

Il separatore mi serve poi per... separare...

Bruno

casanmaner

2024-03-17 15:34:02 UTC

=FILTRO(A2:A1002;CONTA.SE(A2:A1002;A2:A1002)=1)

=FILTER(A1:A13,COUNTIF(A1:A13,A1:A13)=1)
debbo trovare le singolarità di ciascuna coppia (Ax & "|" & Bx)
per x che va da 1 a 13.
Bruno

Non ho ben inteso.
A1|B1
A1|B2
A1|B3
e vorresti estrarre le singolarità per la parte di stringa a sinistra
e a destra di "|" (che sarebbe un separatore)?

AACC    Saponetta
ABAA    Saponetta
ABAA    Saponetta
BCCA    Carta Igienica
BCCA    Carta Igienica
CABA    Dentifricio
CBBA    Dentifricio
CBBA    Dentifricio
CCCA    Saponetta
CCCA    Saponetta
ZZZZ    Caccona
ZZZ2    Cose varie
ZZZZ    Cacca
AACC|Saponetta
CABA|Dentifricio
ZZZZ|Caccona
ZZZ2|Cose varie
ZZZZ|Cacca
Il separatore mi serve poi per... separare...
Bruno

Già più difficile, almeno per me, considerato che il conta.se accetta
solo intervalli e non la combinazione deglis stessi.
Avrei trovato una possibile soluzione macchinosa ma che funziona solo
con Office 365 in quanto sfrutta la funzione MAKEARRAY

=FILTRO($A$1:$A$13&"|"&B1:B13;MAKEARRAY(RIGHE($A$1:$B$13);1;LAMBDA(row;col;MATR.SOMMA.PRODOTTO(--($A$1:$A$13&"|"&B1:B13=INDIRETTO("A"&row)&"|"&INDIRETTO("B"&row)))))=1)

Senza il MAKEARRAY, al momento, non mi è venuta in mente una soluzione :-)

casanmaner

2024-03-17 15:35:31 UTC

Post by casanmaner
Già più difficile, almeno per me, considerato che il conta.se accetta
solo intervalli e non la combinazione deglis stessi.
Avrei trovato una possibile soluzione macchinosa ma che funziona solo
con Office 365 in quanto sfrutta la funzione MAKEARRAY
=FILTRO($A$1:$A$13&"|"&B1:B13;MAKEARRAY(RIGHE($A$1:$B$13);1;LAMBDA(row;col;MATR.SOMMA.PRODOTTO(--($A$1:$A$13&"|"&B1:B13=INDIRETTO("A"&row)&"|"&INDIRETTO("B"&row)))))=1)
Senza il MAKEARRAY, al momento, non mi è venuta in mente una soluzione :-)

Qui i risultati restituiti dalla formula:

Loading Image...

Bruno Campanini

2024-03-17 16:18:45 UTC

Già più difficile, almeno per me, considerato che il conta.se accetta solo
intervalli e non la combinazione deglis stessi.
Avrei trovato una possibile soluzione macchinosa ma che funziona solo con
Office 365 in quanto sfrutta la funzione MAKEARRAY
=FILTRO($A$1:$A$13&"|"&B1:B13;MAKEARRAY(RIGHE($A$1:$B$13);1;LAMBDA(row;col;MATR.SOMMA.PRODOTTO(--($A$1:$A$13&"|"&B1:B13=INDIRETTO("A"&row)&"|"&INDIRETTO("B"&row)))))=1)
Senza il MAKEARRAY, al momento, non mi è venuta in mente una soluzione :-)

https://www.dropbox.com/scl/fi/isc3zblmkit1aktt8abxk/Screenshot-2024-03-17-16.34.14.png?rlkey=bb2fgva01xmt2dmdj6qqi7nhd&dl=0

Una bella formulona, non c'è che dire!

Il tuo MS365 comprende anche Access? e se sì, cosa costa l'anno?

Bruno

casanmaner

2024-03-17 17:00:20 UTC

Post by Bruno Campanini
Una bella formulona, non c'è che dire!

Ho provato a "svilupparla" per avere come risultato le due matrici
suddivise utilizzando una LAMBDA:

=LAMBDA(Matrice1;Matrice2;Separatore;
LET(TestoCombinato;Matrice1&Separatore&Matrice2;
MatriceFiltro;MAKEARRAY(RIGHE(TestoCombinato);1;LAMBDA(row;col;MATR.SOMMA.PRODOTTO(--(TestoCombinato=INDIRETTO(STRINGA.ESTRAI(INDIRIZZO(1;RIF.COLONNA(Matrice1));2;LUNGHEZZA(INDIRIZZO(1;RIF.COLONNA(Matrice1)))-3)&row)&Separatore&INDIRETTO(STRINGA.ESTRAI(INDIRIZZO(1;RIF.COLONNA(Matrice2));2;LUNGHEZZA(INDIRIZZO(1;RIF.COLONNA(Matrice2)))-3)&row)))))=1;
Filtro;FILTRO(TestoCombinato;MatriceFiltro);
PosizioneSeparatore;TROVA(Separatore;Filtro);
ValoriASinistra;SINISTRA(Filtro;PosizioneSeparatore-1);
ValoriADestra;STRINGA.ESTRAI(Filtro;PosizioneSeparatore+1;LUNGHEZZA(Filtro));
STACK.ORIZ(ValoriASinistra;ValoriADestra)))($A$1:$A$13;$B$1:$B$13;"|")

Questo il risultato:

Loading Image...

A voler rendere più "comprensibile" la parte legata alla MatriceFiltro
si potrebbe inserire altri due nomi per la determinazione delle lettere
degli intervalli per i riferimenti indiretti:

STRINGA.ESTRAI(INDIRIZZO(1;RIF.COLONNA(Matrice1));2;LUNGHEZZA(INDIRIZZO(1;RIF.COLONNA(Matrice1)))-3)

e

STRINGA.ESTRAI(INDIRIZZO(1;RIF.COLONNA(Matrice2));2;LUNGHEZZA(INDIRIZZO(1;RIF.COLONNA(Matrice2)))-3)

Post by Bruno Campanini
Il tuo MS365 comprende anche Access? e se sì, cosa costa l'anno?

Io ho optato per la licenza per uso personale "family" che consente la
condivisione con familiari (fino a 5 altri familiari oltre a te) fino a
5 dispositivi.
Ho abbonamento mensile di 10 euro mese.
Ma se fai l'abbonamento annuale spendi 99 euro anno.
Volendo c'è il personal che costa 69 euro anno.
Puoi accedere solo tu ma fino a 5 dispositivi.
https://www.microsoft.com/it-it/microsoft-365/buy/compare-all-microsoft-365-products-b

Poi ci sono le licenze per le aziende:
https://www.microsoft.com/it-it/microsoft-365/business/compare-all-microsoft-365-business-products-b?market=it

A parte la basic (che costa 5,6 euro mese, esclusa iva, per utente) le
altre hanno access.

casanmaner

2024-03-17 17:05:01 UTC

Post by casanmaner
=LAMBDA(Matrice1;Matrice2;Separatore;
LET(TestoCombinato;Matrice1&Separatore&Matrice2;
MatriceFiltro;MAKEARRAY(RIGHE(TestoCombinato);1;LAMBDA(row;col;MATR.SOMMA.PRODOTTO(--(TestoCombinato=INDIRETTO(STRINGA.ESTRAI(INDIRIZZO(1;RIF.COLONNA(Matrice1));2;LUNGHEZZA(INDIRIZZO(1;RIF.COLONNA(Matrice1)))-3)&row)&Separatore&INDIRETTO(STRINGA.ESTRAI(INDIRIZZO(1;RIF.COLONNA(Matrice2));2;LUNGHEZZA(INDIRIZZO(1;RIF.COLONNA(Matrice2)))-3)&row)))))=1;
Filtro;FILTRO(TestoCombinato;MatriceFiltro);
PosizioneSeparatore;TROVA(Separatore;Filtro);
ValoriASinistra;SINISTRA(Filtro;PosizioneSeparatore-1);
ValoriADestra;STRINGA.ESTRAI(Filtro;PosizioneSeparatore+1;LUNGHEZZA(Filtro));
STACK.ORIZ(ValoriASinistra;ValoriADestra)))($A$1:$A$13;$B$1:$B$13;"|")
https://www.dropbox.com/scl/fi/tw5x9buuw8o59gxzf2zjg/Screenshot-2024-03-17-17.54.04.png?rlkey=cxdh9bw16pg39u47lk5issue8&dl=0
A voler rendere più "comprensibile" la parte legata alla MatriceFiltro
si potrebbe inserire altri due nomi per la determinazione delle lettere
STRINGA.ESTRAI(INDIRIZZO(1;RIF.COLONNA(Matrice1));2;LUNGHEZZA(INDIRIZZO(1;RIF.COLONNA(Matrice1)))-3)
e
STRINGA.ESTRAI(INDIRIZZO(1;RIF.COLONNA(Matrice2));2;LUNGHEZZA(INDIRIZZO(1;RIF.COLONNA(Matrice2)))-3)

Qualcosa del genere:

=LAMBDA(Matrice1;Matrice2;Separatore;
LET(TestoCombinato;Matrice1&Separatore&Matrice2;
LetteraColonnaMatrice1;STRINGA.ESTRAI(INDIRIZZO(1;RIF.COLONNA(Matrice1));2;LUNGHEZZA(INDIRIZZO(1;RIF.COLONNA(Matrice1)))-3);
LetteraColonnaMatrice2;STRINGA.ESTRAI(INDIRIZZO(1;RIF.COLONNA(Matrice2));2;LUNGHEZZA(INDIRIZZO(1;RIF.COLONNA(Matrice2)))-3);
MatriceFiltro;MAKEARRAY(RIGHE(TestoCombinato);1;LAMBDA(row;col;MATR.SOMMA.PRODOTTO(--(TestoCombinato=INDIRETTO(LetteraColonnaMatrice1&row)&Separatore&INDIRETTO(LetteraColonnaMatrice2&row)))))=1;
Filtro;FILTRO(TestoCombinato;MatriceFiltro);
PosizioneSeparatore;TROVA(Separatore;Filtro);
ValoriASinistra;SINISTRA(Filtro;PosizioneSeparatore-1);
ValoriADestra;STRINGA.ESTRAI(Filtro;PosizioneSeparatore+1;LUNGHEZZA(Filtro));
STACK.ORIZ(ValoriASinistra;ValoriADestra)))($A$1:$A$13;$B$1:$B$13;"|")

issdr

2024-03-17 18:30:13 UTC

Post by Bruno Campanini
AACC Saponetta
ABAA Saponetta
ABAA Saponetta
BCCA Carta Igienica
BCCA Carta Igienica
CABA Dentifricio
CBBA Dentifricio
CBBA Dentifricio
CCCA Saponetta
CCCA Saponetta
ZZZZ Caccona
ZZZ2 Cose varie
ZZZZ Cacca

[...]

Post by Bruno Campanini
Il separatore mi serve poi per... separare...

senza separatore, ci oensa lo spillover:

=UNICI(A1:B13)

leggo che l'hai anche tu.

issdr

2024-03-17 18:38:04 UTC

[...]

Post by Bruno Campanini
Il separatore mi serve poi per... separare...

=UNICI(A1:B13)
leggo che l'hai anche tu.

non ho guardato nemmeno il risultato, travisando.

eccoci:

=UNICI(A1:B13;0;1)

casanmaner

2024-03-17 19:03:55 UTC

Post by issdr
=UNICI(A1:B13;0;1)

ahahahaha .... così è troppo facile :)

Vabbé, giusto per completare le possibilità utilizzando power query:

let
Origine = Excel.CurrentWorkbook(){[Name="Tabella1"]}[Content],
Nomi_Colonne = Table.ColumnNames(Origine),
Raggruppate_righe = Table.Group(Origine, Nomi_Colonne,
{{"Conteggio", each Table.RowCount(_), Int64.Type}}),
Filtrate_righe = Table.SelectRows(Raggruppate_righe, each
([Conteggio] = 1)),
Rimosse_colonne = Table.RemoveColumns(Filtrate_righe,{"Conteggio"})
in
Rimosse_colonne

Ora arriverà qualcuno che con ancora meno righe di codice M avrà la
tabella con le singolarità

issdr

2024-03-17 19:14:01 UTC

Post by casanmaner
Ora arriverà qualcuno che con ancora meno righe di codice M avrà la
tabella con le singolarità

non l'ho studiato, anche se a naso mi pare molto utile e flessibile.

in VBA, grossolanamente, sul posto (non lo sto provando):

range("A:B").removeduplicates columns:=array(1), header:=xlno
range("A:B").removeduplicates columns:=array(2), header:=xlno

casanmaner

2024-03-17 19:43:08 UTC

Post by issdr
range("A:B").removeduplicates columns:=array(1), header:=xlno
range("A:B").removeduplicates columns:=array(2), header:=xlno

Non va bene.
Le due colonne a sinistra i risultati ottenuti e a destra quelli desiderati:

AACC Saponetta AACC Saponetta
BCCA Carta Igienica CABA Dentifricio
CABA Dentifricio ZZZZ Caccona
ZZZZ Caccona ZZZ2 Cose varie
ZZZ2 Cose varie ZZZZ Cacca

issdr

2024-03-17 22:13:35 UTC

Post by issdr
range("A:B").removeduplicates columns:=array(1), header:=xlno
range("A:B").removeduplicates columns:=array(2), header:=xlno

Non va bene.
AACC Saponetta AACC Saponetta
BCCA Carta Igienica CABA Dentifricio
CABA Dentifricio ZZZZ Caccona
ZZZZ Caccona ZZZ2 Cose varie
ZZZ2 Cose varie ZZZZ Cacca

sì, così si cancellano non doppi in colonna B. Unique anche in VBA e via...

Bruno Campanini

2024-03-17 20:32:22 UTC

[...]

Post by Bruno Campanini
Il separatore mi serve poi per... separare...

=UNICI(A1:B13)
leggo che l'hai anche tu.

non ho guardato nemmeno il risultato, travisando.
=UNICI(A1:B13;0;1)

Questa funziona perfettamente, ma come faccio a prelevare
i singoli elementi di sinistra e destra?
Debbo definire quelle due colonne un range R e prelevare
con R(x,y)...

Bruno

issdr

2024-03-17 22:05:39 UTC

[...]

Post by issdr
=UNICI(A1:B13;0;1)

Questa funziona perfettamente, ma come faccio a prelevare
i singoli elementi di sinistra e destra?

eccola con il separatore:

=UNICI(A1:A13&"|"&B1:B13;;1)

Post by Bruno Campanini
Debbo definire quelle due colonne un range R e prelevare
con R(x,y)...

--8<---------------cut here---------------start------------->8---
Sub Singolarita()
aSing = WorksheetFunction.Unique([A1:B13], , 1)
ReDim vSing(1 To UBound(aSing))
For i = 1 To UBound(aSing)
vSing(i) = aSing(i, 1) & "|" & aSing(i, 2)
Next
End Sub
--8<---------------cut here---------------end--------------->8---

issdr

2024-03-17 22:34:36 UTC

Post by Bruno Campanini
Questa funziona perfettamente, ma come faccio a prelevare
i singoli elementi di sinistra e destra?
Debbo definire quelle due colonne un range R e prelevare
con R(x,y)...

la sub precedente la stavo leggendo nel debug.

prendi su il range con 2 colonne e sputi in colonna I le stringhe
concatenate (escamotage per non dover trasporre il vettore: ho creato un
array bidimensionale con seconda dimensione che va da 1 a 1):

--8<---------------cut here---------------start------------->8---
Sub SingolaritaBis()
aSing = WorksheetFunction.Unique([A1:B13], , 1)
ReDim vSing(1 To UBound(aSing), 1 To 1)
For i = 1 To UBound(aSing)
vSing(i, 1) = aSing(i, 1) & "|" & aSing(i, 2)
Next
Range("I1:I" & UBound(vSing)) = vSing
End Sub
--8<---------------cut here---------------end--------------->8---

issdr

2024-03-18 10:41:51 UTC

Post by Bruno Campanini
Questa funziona perfettamente, ma come faccio a prelevare
i singoli elementi di sinistra e destra?
Debbo definire quelle due colonne un range R e prelevare
con R(x,y)...

niente di complicato. ecco tutto il VBA necessario, te lo riorganizzi
come vuoi:

Loading Image...

casanmaner

2024-03-17 14:41:03 UTC

Con le collection avrei pensato a qualcosa del genere:

Function EstraiSingolarita(rng As Range) As Variant
Dim arr As Variant, v As Variant
Dim oColl As Collection
Dim vTmp As Long
Dim arrOut() As Variant
Dim cont As Long

Set oColl = New Collection
arr = rng.Value
For Each v In arr
On Error Resume Next
If v <> vbNullString Then
oColl.Add 1, v
If Err.Number <> 0 Then
vTmp = oColl(v)
oColl.Remove v
oColl.Add vTmp + 1, v
vTmp = 0
Err.Clear
End If
End If
Next v
For Each v In arr
If v <> vbNullString Then
If oColl.Item(v) = 1 Then
cont = cont + 1
ReDim Preserve arrOut(1 To 1, 1 To cont)
arrOut(1, cont) = v
End If
End If
Next v
EstraiSingolarita = Application.Transpose(arrOut)
End Function

Bruno Campanini

2024-03-17 15:11:58 UTC

Post by casanmaner
Function EstraiSingolarita(rng As Range) As Variant
Dim arr As Variant, v As Variant
Dim oColl As Collection
Dim vTmp As Long
Dim arrOut() As Variant
Dim cont As Long
Set oColl = New Collection
arr = rng.Value
For Each v In arr
On Error Resume Next
If v <> vbNullString Then
oColl.Add 1, v
If Err.Number <> 0 Then
vTmp = oColl(v)
oColl.Remove v
oColl.Add vTmp + 1, v
vTmp = 0
Err.Clear
End If
End If
Next v
For Each v In arr
If v <> vbNullString Then
If oColl.Item(v) = 1 Then
cont = cont + 1
ReDim Preserve arrOut(1 To 1, 1 To cont)
arrOut(1, cont) = v
End If
End If
Next v
EstraiSingolarita = Application.Transpose(arrOut)
End Function

Perfetta anche questa... me la studierò perché con Collection
non sono riuscito a cavare un ragno da un buco.

Ho fatto questa con Dictionary:
============================
Public Sub OnlyOne_ExcelDictionary()

Dim D As New dictionary, SR As Range, SN As String, i, j
Dim TR As Range, Separator As String, S As String, T As Single

' --- Definizioni -----------------------
SN = "BC_3" ' Sheet Name
Set SR = Sheets(SN).[A1] ' Source Range
Set TR = Sheets(SN).[I1] ' Target Range
Separator = "|"
' -----------------------------------------

T = Timer
Sheets(SN).Sort.SortFields.Clear
Set SR = Range(SR, SR.End(xlDown))
D.CompareMode = TextCompare
Range(TR, TR.End(xlDown)).ClearContents

For Each i In SR
S = i(1, 1) & Separator & i(1, 2)
If D.Exists(S) Then
D(S) = D(S) + 1
Else
D.Add Key:=(S), Item:=1
End If
Next

For Each i In D
If D(i) = 1 Then
j = j + 1
TR(j) = i
End If
Next
MsgBox Timer - T

End Sub
========================================
e altra con query, ancor più semplice (basta riportare
da Access una stringa SQL di una riga e pc'altro).

Bruno

Bruno Campanini

2024-03-17 20:25:43 UTC

Function EstraiSingolarita(rng As Range) As Variant
Dim arr As Variant, v As Variant
Dim oColl As Collection
Dim vTmp As Long
Dim arrOut() As Variant
Dim cont As Long
Set oColl = New Collection
arr = rng.Value
For Each v In arr
On Error Resume Next
If v <> vbNullString Then
oColl.Add 1, v
If Err.Number <> 0 Then
vTmp = oColl(v)
oColl.Remove v
oColl.Add vTmp + 1, v
vTmp = 0
Err.Clear
End If
End If
Next v
For Each v In arr
If v <> vbNullString Then
If oColl.Item(v) = 1 Then
cont = cont + 1
ReDim Preserve arrOut(1 To 1, 1 To cont)
arrOut(1, cont) = v
End If
End If
Next v
EstraiSingolarita = Application.Transpose(arrOut)
End Function

Ho esaminato la tua formula sopra riportata.
Anch'io ho provato, quando Collection.Add...
dà errore, di cancellare l'elemento precedente
della Collection, ma non ha funzionato ed ho
abbandonato.
La tua funziona se trova il range in cui va a cercare
è ORDINATO, altrimenti il risultato non è esatto.

Per esempio, sul range:
AACC Saponetta
ABAA Saponetta
BCCA Carta Igienica
CABA Dentifricio
CBBA Dentifricio
CCCA Saponetta
ZZZZ Caccona
ZZZ2 Cose varie
ZZZZ Cacca
ABAA Saponetta
BCCA Carta Igienica
CCCA Saponetta
CBBA Dentifricio

la tua procedura VBA espone:
AACC
ABAA
BCCA
CABA
CBBA
CCCA
ZZZ2

ma il risultato corretto è:
AACC
CABA
ZZZ2

ovvero:
AACC|Saponetta
CABA|Dentifricio
ZZZZ|Caccona
ZZZ2|Cose varie
ZZZZ|Cacca

Io ho perso quasi tutta la mattinata, mattinata corta
perché ho messo i piedi a terra che eran le 10 suonate,
attorno ad una Collection...

Bruno

casanmaner

2024-03-17 20:57:45 UTC

Function EstraiSingolarita(rng As Range) As Variant
    Dim arr As Variant, v As Variant
    Dim oColl As Collection
    Dim vTmp As Long
    Dim arrOut() As Variant
    Dim cont As Long
    Set oColl = New Collection
    arr = rng.Value
    For Each v In arr
       On Error Resume Next
       If v <> vbNullString Then
       oColl.Add 1, v
       If Err.Number <> 0 Then
          vTmp = oColl(v)
          oColl.Remove v
          oColl.Add vTmp + 1, v
          vTmp = 0
          Err.Clear
       End If
       End If
    Next v
    For Each v In arr
       If v <> vbNullString Then
          If oColl.Item(v) = 1 Then
             cont = cont + 1
             ReDim Preserve arrOut(1 To 1, 1 To cont)
             arrOut(1, cont) = v
          End If
       End If
    Next v
    EstraiSingolarita = Application.Transpose(arrOut)
End Function

Ciao Bruno quella FDU, pensata, per un intervallo fatto da una sola
colonna, se applicato ad A1:A13 mi restituisce
AACC
CABA
ZZZ2

Loading Image...

Per gestire la seconda ipotesi andrebbe leggermente modificata in modo
che il riferimento non sia un range ma una matrice di valori

Ad es. questa seconda versione:

Function EstraiSingolarita2(arr As Variant) As Variant
Dim v As Variant
Dim oColl As Collection
Dim vTmp As Long
Dim arrOut() As Variant
Dim cont As Long
Set oColl = New Collection

For Each v In arr
On Error Resume Next
If v <> vbNullString Then
oColl.Add 1, v
If Err.Number <> 0 Then
vTmp = oColl(v)
oColl.Remove v
oColl.Add vTmp + 1, v
vTmp = 0
Err.Clear
End If
End If
Next v
For Each v In arr
If v <> vbNullString Then
If oColl.Item(v) = 1 Then
cont = cont + 1
ReDim Preserve arrOut(1 To 1, 1 To cont)
arrOut(1, cont) = v
End If
End If
Next v
EstraiSingolarita2 = Application.Transpose(arrOut)
End Function

se come argomento passo A1:A13&"|"&B1:B13 ottengo:
AACC|Saponetta
CABA|Dentifricio
ZZZZ|Caccona
ZZZ2|Cose varie
ZZZZ|Cacca

Loading Image...

Poi volendo la FDU potrebbe essere modificata per restituire la matrice
con i valori suddivisi.
O ancora si potrebbe pensare di far inserire un unico intervallo con più
colonne, l'indicazione di un separatore, avere la matrice delle
singolarità poi da suddividere.
Immagino però che la fdu allungherebbe i tempi di elaborazione.

casanmaner

2024-03-17 21:44:58 UTC

Ad es. questa terza versione:

Function EstraiSingolarita3(rng As Range, Optional sSeparatore As String
= "|") As Variant

Dim arr As Variant, v As Variant, i As Long, j As Long
Dim oColl As Collection
Dim vTmp As Long
Dim arrIn() As Variant
Dim arrTmp() As Variant
Dim arrOut() As Variant
Dim cont As Long

Set oColl = New Collection
arr = rng.Value

Dim nRighe As Long
Dim nCol As Long
nRighe = UBound(arr, 1)
nCol = UBound(arr, 2)

ReDim arrTmp(0 To nCol - 1)
ReDim arrIn(0 To nRighe - 1)

For i = 1 To nRighe
For j = 1 To nCol
arrTmp(j - 1) = arr(i, j)
Next j
arrIn(i - 1) = Join(arrTmp, sSeparatore)
Next i

For Each v In arrIn
On Error Resume Next
If v <> vbNullString Then
oColl.Add 1, v
If Err.Number <> 0 Then
vTmp = oColl(v)
oColl.Remove v
oColl.Add vTmp + 1, v
vTmp = 0
Err.Clear
End If
End If
Next v

For Each v In arrIn
If v <> vbNullString Then
If oColl.Item(v) = 1 Then
cont = cont + 1
ReDim Preserve arrOut(1 To nCol, 1 To cont)
arr = Split(v, sSeparatore)
For j = 0 To nCol - 1
arrOut(j + 1, cont) = arr(j)
Next j

End If
End If
Next v
EstraiSingolarita3 = Application.Transpose(arrOut)
End Function

mi restituisce su due colonne distinte questi valori:

AACC Saponetta
CABA Dentifricio
ZZZZ Caccona
ZZZ2 Cose varie
ZZZZ Cacca

Loading Image...

Se si espandesse l'intervallo alla colonna C (per semplicità ricopio gli
stessi valori di colonna B) si otterrebbe:
AACC Saponetta Saponetta
CABA Dentifricio Dentifricio
ZZZZ Caccona Caccona
ZZZ2 Cose varie Cose varie
ZZZZ Cacca Cacca

Loading Image...

issdr

2024-03-17 22:09:02 UTC