VBA: copiare i valori univoci
draleo
in un foglio (sh2) ho un elenco di dati disposti in 2 colonne (codice,
descrizione);
Allo stesso codice corrisponde sempre la stessa descrizione;
Ogni codice e la relativa descrizione possono essere presenti più volte;
Avrei necessità di copiare in un altro foglio (sh5) al range denominato
(“destinazione”).offset(1,0) solo i valori univoci (codice e descrizione)
Ho adoperato la seguente procedura , che consiste:
nel pulire i dati preesistenti in sh5
copiare tutti i dati nel range ( “destinazione”).Offset(1, 0)
ordinare il tutto in base alla descrizione
eliminare l’intera riga se uguale a quella superiore.
Ma con 2000 righe la procedura molto lenta.
Qualcuno può suggerirmi qualcosa di più rapido ? (ho provato con una
collection, ma non sono in grado di usarla )
Grazie
draleo
--------------------------------------------------------------------------------------
Sub copiaunivoci()
'cancello i dati preesistenti
With sh5
Range(.Range("A1000"), .Range("A1000").End(xlDown).Offset(0,2)).Clear
End With
With sh2
If .Range("A15") = "" Then Exit Sub
Set zona = Range(.Range("A15"), .Range("A15").End(xlDown). Offset(0, 1))
zona.Copy Range("destinazione").Offset(1, 0)
End With
With sh5
.Range("A1000").CurrentRegion.Sort Key1:=.Range("A1000"), _
Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Set currentcell = .Range("B1000")
Do While Not IsEmpty(currentcell)
Set nextcell = currentcell.Offset(1, 0)
If nextcell = currentcell Then
currentcell.EntireRow.Delete
End If
Set currentcell = nextcell
Loop
End With
End sub
---------------------------------------------------------------------------------
Roberto Restelli
draleo ha scritto:
> Avrei necessità di copiare in un altro foglio (sh5) al range
> denominato (“destinazione”).offset(1,0) solo i valori univoci (codice
> e descrizione)
[CUT]
> Qualcuno può suggerirmi qualcosa di più rapido ? (ho provato con una
> collection, ma non sono in grado di usarla )
Io cercherei di utilizzare una funzione "nativa" che fa proprio al caso tuo:
il filtro avanzato. Questa funzionalità permette di generare un elenco in
altra posizione, partendo da quello che contiene gli elementi duplicati,
prevedendo anche la copia univoca dei record.
Con il registratore di macro puoi farti generare il codice se esegui
dirattemente l'operazione sul tuo elenco agendo da utente. :-)
Considera che:
- nel filtro avanzato devi indicare l'intervallo di partenza considerando
tutta la zona che contiene il tuo elenco. Quando chiami il comando
"Dati-->Filtro avanzato..." devi già essere posizionato su una cella
dell'intervallo (basta una cella interna, ci pensa Excel ad individuare
l'intervallo completo).
- nel tuo caso l'intervallo dei criteri puoi anche non indicarlo (a meno che
tu voglia fare ulteriori filtri sul contenuto)
- indica il punto dove vuoi venga generato il nuovo elenco senza duplicati
- ricordati di attivare l'opzione "Copia in un'altra posizione"
- ricordati di attivare l'opzione "Copia univoca dei record"
Ricavare il codice finale dovrebbe essere poi una passeggiata.
Essendo una funzionalità nativa le performances dovrebbero essere le
migliori possibili (sicuramente migliori rispetto a qualsiasi linguaggio
interpretato come il VBA).
Ciao
Roberto
--
Roberto Restelli
Microsoft MVP - Office Systems - Outlook
************************************************
La prima raccolta delle FAQ del newsgroup Microsoft di Outlook:
http://www.msoutlook.it
Roberto Restelli
> Con il registratore di macro puoi farti generare il codice se esegui
> dirattemente l'operazione sul tuo elenco agendo da utente. :-)
Il codice è così semplice che ne riporto un esempio:
===
Range("A1:B2000").AdvancedFilter Action:=xlFilterCopy _
, CopyToRange:=Range("L1"), Unique:=True
===
La riga di codice parte da un intervallo da A1 a B2000 e crea a partire da
L1 (sullo stesso foglio) un nuovo elenco coni doppioni eliminati.
Mauro Gamberini
> descrizione);
> Allo stesso codice corrisponde sempre la stessa descrizione;
> Ogni codice e la relativa descrizione possono essere presenti più volte;
> Avrei necessità di copiare in un altro foglio (sh5) al range denominato
> ("destinazione").offset(1,0) solo i valori univoci (codice e descrizione)
>
>
Avvia il registratore macro.
Seleziona una cella della tabella.
Dati-->Filtro-->Filtro avanzato
Spunta: Copia univoca dei record
Ok
Copia le celle
Incollale in un altro foglio.
Togli il filtro.
Dai un'occhiata al codice e modificalo
a seconda delle tue esigenze.
*Poi* se hai problemi, chiedi.
Se invece vuoi utilizzare le Collection,
ad esempio.
In un *MODULO DI CLASSE*
(Rinominalo: clsColonne)
'Dichiarazione campi
Private sCol1 As String
Private sCol2 As String
'*****Proprietà*****
Public Property Get Col1() As String
Col1 = sCol1
End Property
Public Property Let Col1(ByVal s As String)
sCol1 = s
End Property
Public Property Get Col2() As String
Col2 = sCol2
End Property
Public Property Let Col2(ByVal s As String)
sCol2 = s
End Property
In un modulo standard:
Public colColonne As Collection
Public Sub mValoriUnivoci()
Dim sh As Worksheet
Dim rng As Range
Dim c As Range
Dim newRiga As clsColonne
Dim lUltRiga As Long
Dim lCont As Long
Set sh = Worksheets("Foglio1")
If Not colColonne Is Nothing Then
Set colColonne = Nothing
End If
Set colColonne = New Collection
With sh
lUltRiga = .Range("A" & _
Rows.Count).End(xlUp).Row
Set rng = .Range("A2:A" & lUltRiga)
End With
On Error Resume Next
For Each c In rng
With c
Set newRiga = New clsColonne
newRiga.Col1 = _
.Value
newRiga.Col2 = _
.Offset(0, 1).Value
End With
colColonne.Add newRiga, CStr( _
newRiga.Col1 & newRiga.Col2)
Next
On Error GoTo 0
Set sh = Nothing
Set sh = Worksheets("Foglio2")
With sh
lCont = 0
For Each newRiga In colColonne
lCont = lCont + 1
.Cells(lCont, 1).Value = newRiga.Col1
.Cells(lCont, 2).Value = newRiga.Col2
Next
End With
Set c = Nothing
Set rng = Nothing
Set sh = Nothing
Set newRiga = Nothing
Set colColonne = Nothing
End Sub
Qui copio in modo univoco valori in colonna A e B
dal Foglio1 al Foglio2.
--
---------------------------
Mauro Gamberini
http://www.riolab.org/
http://blog.maurogsc.eu/
draleo
tempo
Ma non dubito della sua efficacia
grazie
draleo
"Mauro Gamberini" ha scritto:
Mauro Gamberini
> più
> tempo
>
<PrimoPost>
Qualcuno può suggerirmi qualcosa di più rapido ? (ho provato con una
collection, ma non sono in grado di usarla )
</PrimoPost>
Sei tu che hai scritto di Collection... ;-)