VBA: contare i nomi univoci di una colonna

[draleo]

Nella colonna A ho circa 50mila nomi di persone (moltissimi ripetuti)
es: Mario Rossi ecc.
Vorrei CONTARE il loro numero (escludendo le ripetizioni)
Ho trovato la soluzione utilizzando delle formule, ma non sono in grado di applicarle perchè le formule mi sono molto ostiche e perchè ,essendo un elenco dinamico le cui righe vengono di volta in volta cancellate e ricreate, tali formule mi danno sempre errore (RIF ecc)
Mi servirebbe quindi una soluzione VBA(la più veloce possibile)
grazie
draleo

[draleo]

Ok, ho risolto da solo
Ho creato una collection e contato i suoi elementi
Non è un fulmine di velocità (credo), ma meglio di niente...
draleo

[draleo]

Questa è la macro (ripresa da questo gruppo,tanto tempo fa). Se qualcuno ha soluzioni più veloci...

Sub conta_nomi_univoci()
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range, rCell As Range
Dim LRow As Long
Dim NoDupes As New Collection
Set WB = ActiveWorkbook
Set SH = WB.Sheets("statis accert")
LRow = Cells(Rows.count, "A").End(xlUp).Row
Set Rng = SH.Range("A13:A" & LRow)

On Error Resume Next
For Each rCell In Rng.Cells
With rCell
If Not IsEmpty(.Value) Then
NoDupes.Add .Value, CStr(.Value)
End If
End With
Next rCell
msgbox NoDupes.count
End Sub

[Scossa]

Puoi velocizzare usando un array:

Sub conta_nomi_univoci2()

Dim WB As Workbook
Dim SH As Worksheet

Dim Rng As Range, rCell As Variant

Dim LRow As Long
Dim NoDupes As New Collection

Dim aDati()

Set WB = ActiveWorkbook
Set SH = WB.Sheets("statis accert")

LRow = Cells(Rows.Count, "A").End(xlUp).Row

Set Rng = SH.Range("A13:A" & LRow)

aDati = Rng

On Error Resume Next
For Each rCell In aDati
If Not IsEmpty(rCell) Then
NoDupes.Add rCell, CStr(rCell)
End If
Next rCell
Set WB = Nothing
Set SH = Nothing
Set Rng = Nothing
MsgBox NoDupes.Count
End Sub

[draleo]

Si,grazie
Impiega circa 1/3 del tempo della mia (con un pc vecchiotto e su 60.000 righe 5 sec contro 16)
Potresti modificarla in modo da aggiungere le voci della collection alla
UserForm2.listbox2 ?
draleo

Il giorno domenica 10 febbraio 2013 17:38:14 UTC+1, Scossa ha scritto:

[draleo]

Pardon; forse mi sono espresso male. intendevo
Potresti modificarla in modo da METTERE (non aggiungere)le voci della collection alla UserForm2.listbox2 ?
La listbox infatti è vuota
draleo

[r]

Il giorno domenica 10 febbraio 2013 22:53:35 UTC+1, draleo ha scritto:
> Pardon; forse mi sono espresso male. intendevo
>
> Potresti modificarla in modo da METTERE (non aggiungere)le voci della collection alla UserForm2.listbox2 ?

Sub test()
UserForm2.ListBox2.List = Un_col([a1:a40000], True)
UserForm2.Show
End Sub

Function Un_col(rng As Excel.Range, Optional bIsList As Boolean)
Dim col As New Collection
Dim v, arr, i As Long, t As Long
arr = rng.Value
On Error Resume Next
For Each v In arr
If Not IsEmpty(v) Then
col.Add v, CStr(v)
End If
Next
On Error GoTo 0
t = col.Count
ReDim v(1 To t)
If bIsList Then
For i = 1 To t
v(i) = col.Item(i)
Un_col = v
Next
Else
Un_col = t
End If
End Function

[r]

in questa caso il dizionario è decisamente più veloce ...

Sub test()
UserForm2.ListBox2.List = Un_col([a1:a60000], True)
UserForm2.Show
End Sub

Function Un_col(rng As Excel.Range, Optional bList As Boolean)
Dim col As Object, v, arr
arr = rng.Value
Set col = CreateObject("Scripting.Dictionary")

For Each v In arr
If Not IsEmpty(v) Then

col.Item(v) = ""
End If
Next
If bList Then
Un_col = col.keys
Else
Un_col = col.Count
End If
End Function

[Maurizio Borrelli]

Il giorno domenica 10 febbraio 2013 23:25:37 UTC+1, r ha scritto:
> in questa caso il dizionario è decisamente più veloce ...

Anche questa non sarebbe male come velocità:

(Un par di secondi con 786.432 record di due campi - "Valore" e "Nome" - in Foglio1 e senza intestazioni in Foglio2)

Public Sub aTest()
Dim a As Variant
Dim t As Date
Dim r As Long
Dim i As Long

a = Array(Array("Foglio1!A:B", 2, True) _
, Array("Foglio2!A:B", 2, False))
For i = 0 To 1
t = Now
r = CountUnique(Application.Range(a(i)(0)), a(i)(1), a(i)(2))
t = Now - t
If r < 0 Then
MsgBox "Elaborazione conclusa con errori."
Else
MsgBox "RecordCount = " & CStr(r) _
, vbInformation + vbOKOnly _
, Format$(t, "hh:nn:ss")
End If
Next
End Sub

Private Function CountUnique(ByVal rng As Excel.Range _
, ByVal fld As Long _
, ByVal hdr As Boolean) As Long
On Error GoTo ErrH

Const cFName = "RCount"

Dim rst As Object 'ADODB.Recordset
Dim c As String
Dim s As String
Dim f As String

With Excel.ThisWorkbook
c = "Provider=Microsoft.ACE.OLEDB.12.0" _
& ";Data Source=" & .FullName _
& ";Extended Properties=""Excel 12.0;ReadOnly=Yes" _
& ";HDR=" & Format$(hdr, ";""Yes"";""No""") & ";""" _
& ";"
End With
With rng
If hdr Then
f = .Cells(1, fld).Value
Else
f = "F" & CStr(fld)
End If
s = "[" _
& .Worksheet.Name & "$" _
& .Address(False, False, xlA1) _
& "]"
End With
s = "SELECT DISTINCT [" & f & "] FROM " & s
s = "SELECT Count(*) AS [" & cFName & "] FROM (" & s & ");"

Set rst = CreateObject("ADODB.Recordset")
With rst
.Open s, c
If .BOF And .EOF Then
CountUnique = 0
Else
CountUnique = .Fields(cFName).Value
End If
End With

ExtP:
On Error Resume Next
rst.Close
Set rst = Nothing
Exit Function

ErrH:
CountUnique = -1
Resume ExtP

End Function

--
Ciao!
Maurizio

[draleo]

La procedura di r (con il dizionario) funziona bene e mi fa risparmiare il 30% del tempo impiegato con una precedente procedura (che però, in più ,caricava i dati nella listbox ordinati alfabeticamente)

La procedura di Maurizio invece mi dà "Elaborazione conclusa con errori", ma probabilmente sono io che non ne ho capito il funzionamento
1)Ho messo nella colonna A (valori) dei num progressivi (da 1 a 60.000) e sulla colonna B (nome) dei nomi ripetuti innumerevoli volte. Ottengo un conteggio dei record (980) –sono il conteggio dei valori univoci ?- e poi l’errore: Elaborazione conclusa con errori
2)Allora ho invertito le colonne : in A (nome) ho messo dei nomi ripetuti e nella colonna B (valore) ho messo dei num progressivi (da 1 a 60000). Stavolta Ottengo il conteggio di tutti i record (60.000) ?- e poi l’errore: Elaborazione conclusa con errori
In entrambi i casi nel foglio2 non viene scritto niente
Dove sbaglio ?
draleo

[Maurizio Borrelli]

Il giorno lunedì 11 febbraio 2013 19:08:16 UTC+1, draleo ha scritto:

Ciao draleo,

[...]

> La procedura di Maurizio invece mi dà "Elaborazione conclusa con errori", ma probabilmente sono io che non ne ho capito il funzionamento

Hai provato l'esecuzione passo passo?

Forse scritta cosi' e' piu' chiaro; ho anche aggiunto la possibilita' di ottenere la lista, visto che pare ti interessi:

Public Sub bTest()
Dim t As Date
Dim r As Variant
Dim v As Variant

Dim lngColumn As Long
Dim blnHasHeaders As Boolean
Dim blnGetList As Boolean

lngColumn = 2
blnHasHeaders = True
blnGetList = True

t = Now
r = GetUnique(Range("Foglio1!A:B"), lngColumn, blnHasHeaders, blnGetList)

t = Now - t

If IsError(r) Then
Debug.Print "Elaborazione conclusa con errori."
Else
If blnGetList Then
If UBound(r) < 0 Then
Debug.Print "RecordCount = 0"
Else
Debug.Print "RecordCount = " & CStr(UBound(r, 2) + 1)
For Each v In r
Debug.Print , v
Next
End If
Else
Debug.Print "RecordCount = " & CStr(r)
End If
End If
End Sub

Private Function GetUnique(ByVal RangeObject As Excel.Range _
, ByVal Column As Long _
, ByVal hasHeaders As Boolean _
, ByVal getList As Boolean _
) As Variant

On Error GoTo ErrH

Const cFName = "RCount"

Dim rst As Object 'ADODB.Recordset
Dim c As String
Dim s As String
Dim f As String

With Excel.ThisWorkbook
c = "Provider=Microsoft.ACE.OLEDB.12.0" _
& ";Data Source=" & .FullName _
& ";Extended Properties=""Excel 12.0;ReadOnly=Yes" _

& ";HDR=" & Format$(hasHeaders, ";""Yes"";""No""") & ";""" _
& ";"
End With
With RangeObject
If hasHeaders Then
f = .Cells(1, Column).Value
Else
f = "F" & CStr(Column)

End If
s = "[" _
& .Worksheet.Name & "$" _
& .Address(False, False, xlA1) _
& "]"
End With
s = "SELECT DISTINCT [" & f & "] FROM " & s

If Not getList Then

s = "SELECT Count(*) AS [" & cFName & "] FROM (" & s & ");"

End If

Set rst = CreateObject("ADODB.Recordset")
With rst
.Open s, c
If .BOF And .EOF Then

If getList Then
GetUnique = Array()
Else
GetUnique = 0
End If
Else
If getList Then
GetUnique = .GetRows
Else
GetUnique = .Fields(cFName).Value

End If
End If
End With

ExtP:
On Error Resume Next
rst.Close
Set rst = Nothing
Exit Function

ErrH:

GetUnique = CVErr(xlErrValue)

[draleo]

Si. Funziona eccezionalmente bene (0,8 sec per 60.000 record).E' da studiare bene.si può modificare in modo da considerare i dati di una sola colonna (dovrebbe velocizzarsi ancora)? e magari caricare i risultati nella UserForm2.Listbox2 ,anziché nella finestra immediata ?
grazie mille
draleo

[r]

Il giorno lunedì 11 febbraio 2013 19:08:16 UTC+1, draleo ha scritto:

> La procedura di r (con il dizionario) funziona bene e mi fa risparmiare il 30% del tempo impiegato con una precedente procedura (che però, in più ,caricava i dati nella listbox ordinati alfabeticamente)

beh non l'avevi detto che li volevi ordinati

> In entrambi i casi nel foglio2 non viene scritto niente

e cosa dovrebbe essere scritto nel foglio2?

------------------------------------------
altra via che restituisce l'elenco ordinato in listbox2 di userform2:

Function Unique_With_Pivot(rng As Excel.Range)
Dim r As Excel.Range, sPFName As String
Dim PC As PivotCache, PT As PivotTable
Set r = rng.Parent.Parent.Worksheets.Add.[a3]
sPFName = rng(1).Value
Set PC = rng.Parent.Parent.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=rng.Address(, , , True))

Set PT = r.Parent.PivotTables.Add(PC, r, "tabella_pivot_x")
With PT.PivotFields(sPFName)
.Orientation = xlRowField
.Position = 1
Unique_With_Pivot = .DataRange.Value
End With
Application.DisplayAlerts = False
r.Parent.Delete
Application.DisplayAlerts = True
End Function

Sub test()
UserForm2.ListBox2.List = Unique_With_Pivot([a1:a100000])
UserForm2.Show
End Sub

-----------------------------------------

saluti
r

[Maurizio Borrelli]

Il giorno lunedì 11 febbraio 2013 22:49:06 UTC+1, draleo ha scritto:
> Si. Funziona eccezionalmente bene (0,8 sec per 60.000 record).E' da studiare bene.si può modificare in modo da considerare i dati di una sola colonna (dovrebbe velocizzarsi ancora)? e magari caricare i risultati nella UserForm2.Listbox2 ,anziché nella finestra immediata ?

Ciao draleo,

1. Ocio che la funzione **considera i dati di una sola colonna**.

2. I risultati li puoi caricare dove vuoi tu. La macro "bTest" e' **solo** un esempio d'uso della funzione che ho chiamato "GetUnique". La tua domanda nascosta e', per caso: "Come si caricano i valori di un Array in una ListBox?". Io pensavo lo sapessi fare. Comunque domanda pure...

--
Ciao!
Maurizio

[draleo]

Ok; molto bene. Ora i dati vengono caricati lella list box ordinati alfabeticamente e il tempo impiegato rimane lo stesso della precedente (cioè molto breve)
Grazie
draleo

[draleo]

Si. In effetti ,provando, sono riuscito abbastanza facilmente a caricare i dati nella listBox
sostituendo

For Each v In r
Debug.Print , v
Next

con

For Each v In r

UserForm2.ListBox2.AddItem v
Next
e tutto si mantiene in tempi eccezionalmente veloci
Grazie anche a te
draleo
PS. da quando uso queste 2 procedure incorro spesso nel messaggio "memoria esaurita" e devo chiudere il file senza poterlo salvare. Si può rimediare ?

[Maurizio Borrelli]

Il giorno martedì 12 febbraio 2013 13:18:22 UTC+1, draleo ha scritto:
[...]

> PS. da quando uso queste 2 procedure incorro spesso nel messaggio "memoria esaurita" e devo chiudere il file senza poterlo salvare. Si può rimediare ?

Ciao draleo,

scusa, esattamente a quale procedura ti riferisci? E... riesci a capire qual'e' l'istruzione che crea il problema?

--
Ciao!
Maurizio

[draleo]

Non è facile capire in quale procedura e in quale passaggio si verificava il messaggio di memoria esaurita. Forse, ieri sera, per provare le tue 2 procedure + quella di r (che creava un dizionario),lavoravo con 3-4 file xls aperti contemporaneamente e passavo dall'uno all'altro senza chiuderne nessuno. Oppure, Forse, per capirne il funzionamento, avevo introdotto qualche modifica mia, che provocava tale messaggio
Fatto è che oggi lavorando, di volta in volta, con un singolo file aperto, il problema non si ripresenta
Comunque avrò sicuramente altri quesiti da chiarire su questa procedura, ma prima di dire cazzate, vorrei studiarla bene per focalizzare gli eventuali dubbi
Appena ripulito il cervello tornerò a farmi vivo
draleo

[Bruno Campanini]

draleo wrote on 10-02-13 :

Un bicchiere d'acqua fresca...

È necessario che l'elenco dei nomi (colonna) abbia come label "NAME" e
che il RowSource del ComboBox (o ListBox) della user's form porti il
nome Uniques.

Richiede:
Microsoft Office 14.0 Access database engine Object Library
o equivalente Reference a DAO 3.60 per versioni di Office
anteriori alla 2010

=============================================
Public Sub UniqueValues()
Dim TargetRange As Range, T As Double
Dim SQL As String, RS As DAO.Recordset
Dim db As DAO.Database, xlFileName As String
Dim xlSheetName As String, xlColumnLabel As String

' --- Definizioni ------------------------------
xlFileName = "D:\Document\Excel\XLS\Book2.xlsm"
xlSheetName = "BC"
xlColumnLabel = "NAME"
Set TargetRange = [BC!B2]
' ----------------------------------------------

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
xlSheetName = xlSheetName & "$"
T = Timer
Set db = OpenDatabase(xlFileName, False, False, "Excel 8.0;")
SQL = "SELECT " & xlSheetName & "." & xlColumnLabel & " "
SQL = SQL & "FROM [" & xlSheetName & "] "
SQL = SQL & "GROUP BY " & xlSheetName & "." & xlColumnLabel & " "
SQL = SQL & "ORDER BY " & xlSheetName & "." & xlColumnLabel & ";"
Set RS = db.OpenRecordset(SQL, dbOpenDynaset)
TargetRange.CopyFromRecordset RS
ThisWorkbook.Names.Add Name:="Uniques", RefersTo:=Range(TargetRange, _
TargetRange.Offset(RS.RecordCount - 1))
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox Timer - T

End Sub
============================================

Bruno

Bruno

[r]

e un'altra ancora ... a quante siamo? chi si occupa degli sprint test? :-)

Sub test()
With UserForm1
.ListBox1.List = rNoDup([a2:a20000])
.TextBox1.Value = .ListBox1.ListCount
.Show
End With
End Sub

Function rNoDup(rng As Excel.Range)
Dim destR As Excel.Range
With Application
.ScreenUpdating = False
.DisplayAlerts = False
Set destR = rng.Parent.Parent.Worksheets.Add.Range(rng.Address)
rng.Copy destR
destR.RemoveDuplicates 1
rNoDup = destR.Resize(Application.CountA(destR)).Value
destR.Parent.Delete
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Function

:-)
r

[r]

ufff ... avevo dimenticato di ordinare :-)

Sub test()
With UserForm1
.ListBox1.List = rNoDup([a1:a20000])

.TextBox1.Value = .ListBox1.ListCount
.Show
End With
End Sub

Function rNoDup(rng As Excel.Range, _
Optional rSortOrder As XlSortOrder = 1)

Dim destR As Excel.Range
With Application
.ScreenUpdating = False
.DisplayAlerts = False

Set destR = rng.Parent.Parent.Worksheets.Add.Range(rng.Address)
rng.Copy destR
destR.RemoveDuplicates 1

Set destR = destR.Resize(Application.CountA(destR))
destR.Sort destR, rSortOrder, , , , , , xlGuess
rNoDup = destR.Value

destR.Parent.Delete

.ScreenUpdating = True
.DisplayAlerts = True
End With

End Function

saluti
r

[r]

ho provato con 120.000 records ... l'ultima che ho inviato impiega 1 sec ... quella con la pivot 2 ... quella di maurizio mi restituisce errori in più riprese ... ho passato
res = GetUnique(rng, 1, True, True)
dove
rng=[1!a1:a120000]

uso excel 2010, ho modificato la versione in 14.0 nella stringa di connessione ...

comunque in conclusione penso che 1 secondo per avere i dati (120.000 righe) filtrati ordinati e caricati e usando solo excel sia un risultato più che soddisfacente ...

saluti
r

[Maurizio Borrelli]

Il giorno giovedì 14 febbraio 2013 14:04:56 UTC+1, r ha scritto:
> quella di maurizio mi restituisce errori in più riprese ... ho passato
> res = GetUnique(rng, 1, True, True)
> dove
> rng=[1!a1:a120000]
> uso excel 2010, ho modificato la versione in 14.0 nella stringa di connessione

[...]

Spiacente Roberto,

dialogo con persone che scrivono "mi restituisce errori", e basta, solo se sono frequentatori NON abituali del ng. ;-) + :-P

--
Ciao!
Maurizio

[r]

aggiungo il codice che ho usato (tutto) ... i dati sono in a1:a120000 ... ho salvato il file (perchè comunque la funzione di Maurizio necessita che il file sia salvato)
così mi restituisce errore impossibile trovare isam installabile ... se lascio la versione 12.0 nella stringa di connessione mi restituisce un errore 80040e37 access non riesce a trovare l'oggetto '1$A1:A120000' ... modificando $ con ! restituisce un errore 80004005 come nel primo caso ma con la descrizione '1!A1:A120000' non è un nome valido ...

ok questo tutto il codice:

Sub test()
Dim d As Double, rng As Excel.Range, res

Set rng = [1!a1:a120000]

d = Timer
res = rNoDup(rng)
rng.Offset(, 1).Resize(UBound(res)).Value = res
Debug.Print "rNoDup tot record: " & UBound(res) & " Tempo: " & Timer - d

d = Timer
res = Unique_With_Pivot(rng)
rng.Offset(, 2).Resize(UBound(res)).Value = res
Debug.Print "Unique_With_Pivot tot record: " & UBound(res) & " Tempo: " & Timer - d

d = Timer

res = GetUnique(rng, 1, True, True)

rng.Offset(, 3).Resize(UBound(res)).Value = res
Debug.Print "GetUnique tot record: " & UBound(res) & " Tempo: " & Timer - d

End Sub



Function rNoDup(rng As Excel.Range, _

Optional rSortOrder As XlSortOrder = xlAscending)

Dim destR As Excel.Range
With Application
.ScreenUpdating = False
.DisplayAlerts = False

Set destR = rng.Parent.Parent.Worksheets.Add.Range(rng.Address)
rng.Copy destR
destR.RemoveDuplicates 1

Set destR = destR.Resize(Application.CountA(destR))
destR.Sort destR, rSortOrder, , , , , , xlGuess
rNoDup = destR.Value

destR.Parent.Delete

.ScreenUpdating = True
.DisplayAlerts = True
End With

End Function

Function Unique_With_Pivot(rng As Excel.Range)
Dim r As Excel.Range, sPFName As String
Dim PC As PivotCache, PT As PivotTable
Set r = rng.Parent.Parent.Worksheets.Add.[a3]
sPFName = rng(1).Value
Set PC = rng.Parent.Parent.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=rng.Address(, , , True))

Set PT = r.Parent.PivotTables.Add(PC, r, "tabella_pivot_x")
With PT.PivotFields(sPFName)
.Orientation = xlRowField
.Position = 1
Unique_With_Pivot = .DataRange.Value
End With
Application.DisplayAlerts = False
r.Parent.Delete
Application.DisplayAlerts = True
End Function

Private Function GetUnique(ByVal RangeObject As Excel.Range _
, ByVal Column As Long _
, ByVal hasHeaders As Boolean _
, ByVal getList As Boolean _
) As Variant

'necessita che la cartella di lavoro sia salvata

'On Error GoTo ErrH

Const cFName = "RCount"

Dim rst As Object 'ADODB.Recordset
Dim c As String
Dim s As String
Dim f As String
With Excel.ThisWorkbook
c = "Provider=Microsoft.ACE.OLEDB.12.0" _
& ";Data Source=" & .FullName _
& ";Extended Properties=""Excel 12.0;ReadOnly=Yes" _
& ";HDR=" & Format$(hasHeaders, ";""Yes"";""No""") & ";""" _
& ";"
End With
With RangeObject
If hasHeaders Then
f = .Cells(1, Column).Value
Else
f = "F" & CStr(Column)

End If
s = "[" _

& .Worksheet.Name & "!" _

[r]

Il giorno giovedì 14 febbraio 2013 14:16:24 UTC+1, Maurizio Borrelli ha scritto:
> Il giorno giovedì 14 febbraio 2013 14:04:56 UTC+1, r ha scritto: > quella di maurizio mi restituisce errori in più riprese ... ho passato > res = GetUnique(rng, 1, True, True) > dove > rng=[1!a1:a120000] > uso excel 2010, ho modificato la versione in 14.0 nella stringa di connessione [...] Spiacente Roberto, dialogo con persone che scrivono "mi restituisce errori", e basta, solo se sono frequentatori NON abituali del ng. ;-) + :-P -- Ciao! Maurizio

si hai ragione ... era stata la fretta, chiedo scusa ... vedi il post appena postato prima ancora di leggere il tuo :-(

[r]

Il giorno giovedì 14 febbraio 2013 14:19:02 UTC+1, r ha scritto:
ufff!

con versione 14.0 mi restituisce errore impossibile trovare isam installabile ... se lascio la versione 12.0 nella stringa di connessione mi restituisce un errore 80040e37 access non riesce a trovare l'oggetto '1$A1:A120000' ... modificando $ con ! restituisce un errore 80004005 come nel primo caso ma con la descrizione '1!A1:A120000' non è un nome valido ...

[draleo]

Allora .
Con 115mila righe da esaminare,excel2007,processore Atlon 64 dualcore,
2 giga RAM
in quanto a velocità vi sono pochi decimi di sec di differenza tra le
varie soluz che quindi non sono significativa (considerando che non si
esamineranno mai 115mila righe).
Per quanto riguarda i valori non unici estratti invece c'è qualche
differenza
a) Soluzione di Maurizio: 1,71 sec con 1031 estratti
b) Soluzione di r con NOdup: 0,95 sec con 1004 estratti
c) soluz di r con Pivot: 0,42 sec con 1005 estratti
d) soluz di r con dizionario : 0,48 sec con 1031 estratti
e) soluz di Bruno : 1,06 sec con 1031 estratti

Grazie a tutti voi , Maestri
draleo

[r]

le soluzioni con 1031 risultati distinguono Mario Rossi da mario rossi, quelle con 1004 e 1005 hanno la sola differenza dell'intestazione di colonna e in effetti la rNoDup meglio cambiare questa riga:

destR.Sort destR, rSortOrder, , , , , , xlGuess

o rendendo xlguess un parametro variabile oppure togliendolo ...

penso che trattandosi di nomi la distinzione tra maiuscole e minuscole è meglio evitarla no?

ciao
r

[r]

ciao Maurizio
mi sono letto questo:
http://support.microsoft.com/kb/257819/it
la $ ha il suo perchè :-) onestamente non lo sapevo, ado lo uso normalmente per recuperare dati da db e non da excel.

ho provato su excel 2007 e funziona ... anche se non mi piace per alcuni motivi ... primo il file deve essere salvato ... secondo la matrice che viene restituita è difficile da caricare ... per esempio a caricarla nel range bisogna fare così:
rng.Offset(, 3).Resize(UBound(res) + 1, 2).Value = Application.Transpose(res)

perchè viene restituita una matrice tipo
res(0 to 0, 0 to 854)

adesso che ho le idee più chiare domani proverò ancora con il 2010 ... ufff che fatica!
:-)
r

[Maurizio Borrelli]

Ciao r,

nella vita normale i file vanno sempre salvati. :)

Anche a me non entusiasma, pero' mi piace il fatto che posso restituire la lista col metodo GetRows dell'oggetto Recordset di ADO:

Function GetUnique(...) As variant
(...)
GetUnique = rst.GetRows
End Function

e che posso caricarlo in una ListBox con la proprieta' List cosi':

Dim res As variant
res = GetUnique(...)
ListBox1.List = WorksheetFunction.Transpose(res)

--
Ciao!
Maurizio

[Bruno Campanini]

draleo expressed precisely :

> Allora .
> Con 115mila righe da esaminare,excel2007,processore Atlon 64 dualcore,
> 2 giga RAM
> in quanto a velocità vi sono pochi decimi di sec di differenza tra le
> varie soluz che quindi non sono significativa (considerando che non si
> esamineranno mai 115mila righe).
> Per quanto riguarda i valori non unici estratti invece c'è qualche
> differenza
> a) Soluzione di Maurizio: 1,71 sec con 1031 estratti
> b) Soluzione di r con NOdup: 0,95 sec con 1004 estratti
> c) soluz di r con Pivot: 0,42 sec con 1005 estratti
> d) soluz di r con dizionario : 0,48 sec con 1031 estratti
> e) soluz di Bruno : 1,06 sec con 1031 estratti

Se poi volessi spulciare più colonne (Nome, Cognome, Indirizzo, etc)
e avere a disposizione altrettante chiavi di sort in cascata, avendo
altresì gli stessi campi con relative intestazioni nella ComboBox o
ListBox... batti un colpo.

Bruno

[r]

si getrows piace anche a me. per caricare nella listbox con list basta poco ... si ciuccia quasi tutto :-)

p.s.
provata anche sul portatile adesso sul treno (excel 2010) e ha funzionato senza errori, anche se non capisco perchè non si prende 14.0 come versione e non capisco nemmeno quel f = "F" & CStr(Column) nel caso di chiamata della funzione senza intestazioni ...

ciao
r

[Maurizio Borrelli]

Il giorno venerdì 15 febbraio 2013 09:21:51 UTC+1, r ha scritto:
[...]

> provata anche sul portatile adesso sul treno (excel 2010) e ha funzionato senza errori, anche se non capisco perchè non si prende 14.0 come versione e non capisco nemmeno quel f = "F" & CStr(Column) nel caso di chiamata della funzione senza intestazioni ...

Ciao r,
perché sin dai tempi antichi quando una tabella non ha intestazioni di colonne (HDR=No) viene usato, dal "motore", un nome composto dall'iniziale della parola "Field" concatenato al numero di colonna.

--
Ciao!
Maurizio

[r]

vuol dire che sono giovane :-)
grazie!

[r]

Il giorno venerdì 15 febbraio 2013 00:46:13 UTC+1, Maurizio Borrelli ha scritto:
> Il giorno giovedì 14 febbraio 2013 23:33:28 UTC+1, r ha scritto: > Il giorno giovedì 14 febbraio 2013 14:27:36 UTC+1, r ha scritto: > mi sono letto questo: > http://support.microsoft.com/kb/257819/it > la $ ha il suo perchè :-) :-) > onestamente non lo sapevo, ado lo uso normalmente per recuperare dati da db e non da excel. > ho provato su excel 2007 e funziona ... anche se non mi piace per alcuni motivi ... primo il file deve essere salvato ... secondo la matrice che viene restituita è difficile da caricare ... per esempio a caricarla nel range bisogna fare così: > rng.Offset(, 3).Resize(UBound(res) + 1, 2).Value = Application.Transpose(res) > perchè viene restituita una matrice tipo > res(0 to 0, 0 to 854) > adesso che ho le idee più chiare domani proverò ancora con il 2010 ... ufff che fatica! Ciao r, nella vita normale i file vanno sempre salvati. :) Anche a me non entusiasma, pero' mi piace il fatto che posso restituire la lista col metodo GetRows dell'oggetto Recordset di ADO: Function GetUnique(...) As variant (...) GetUnique = rst.GetRows End Function e che posso caricarlo in una ListBox con la proprieta' List cosi': Dim res As variant res = GetUnique(...) ListBox1.List = WorksheetFunction.Transpose(res) -- Ciao! Maurizio

c'è un altra cosa che non mi piace affatto ... in presenza di celle vuote con valori empty getrows restituisce valori null che spesso in excel creano problemi ... usando copyfromrecordset (come ha fatto bruno) vengano convertiti in empty ... interessante invece al link che ho inviato ieri il discorso delle prime 8 righe e della scelta di dato ... per usare ado bisogna essere bene certi che i valori nelle celle siano coerenti e in excel non è una cosa così scontata ... se ad esempio avendo dati misti :
empty
"c"
1
2
3
01/01/2013

il risultato è
null
1
2
3
41275

saluti
r

[Maurizio Borrelli]

Il giorno venerdì 15 febbraio 2013 11:26:52 UTC+1, r ha scritto:

> c'è un altra cosa che non mi piace affatto ... in presenza di celle vuote con valori empty getrows restituisce valori null che spesso in excel creano problemi ... usando copyfromrecordset (come ha fatto bruno) vengano convertiti in empty ... interessante invece al link che ho inviato ieri il discorso delle prime 8 righe e della scelta di dato ... per usare ado bisogna essere bene certi che i valori nelle celle siano coerenti e in excel non è una cosa così scontata ... se ad esempio avendo dati misti :
> empty
> "c"
> 1
> 2
> 3
> 01/01/2013
> il risultato è
> null
> 1
> 2
> 3
> 41275

Ciao r,
per cose di questo genere esiste, apposta, una delle prime leggi dell'informatica:
http://it.wikipedia.org/wiki/Garbage_In,_Garbage_Out
Mi sembra quasi banale affermare che la soluzione query-sql vada usata in situazioni in cui vi siano dati che abbiano le caratteristiche di una tabella di database in un ambiente, non so come definirlo, diciamo "controllato".
--
Ciao!
Maurizio