Condividi:        

[Excel] Copia combinazioni di dati

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

[Excel] Copia combinazioni di dati

Postdi theterrible » 24/09/12 11:21

Buongiorno a tutti; mi sono appena iscritto su questo forum per richiederVi aiuto sullo sviluppo di una macro.

Prima di postare ho cercato sul forum quante più informazioni mi potessero servire per iniziare la realizzazzione di essa.
Come da voi suggerito ho avviato la registrazione macro ed eseguito i compiti che la macro deve compiere automaticamente, ho guardato il codice e cercato di capire i vari comandi a cosa servivano.

Premetto che questa macro la sto realizzando negli orari morti di lavoro e mi serve per la realizzazzione di un file da consegnare ad un reparto produttivo della mia azienda, quindi il tempo per pensare non è molto.

Vi posto quanto ho già realizzato e cosa mi serve.
Codice: Seleziona tutto
Sub comboHrT()
'
' comboHrT Macro
' Macro per la copia delle combinazioni di Umidità e Temperatura per ogni articolo
' presente in tabella prove rotoli

'
    Windows("Tabella Prove Rotoli 2012.xls").Activate  ' apertura del file da cui prelevare i dati
   
' parte da ripetere con gli altri articoli
    UR = Range("A" & Rows.Count).End(xlUp).Row
    ActiveSheet.Range("$1:UR").AutoFilter Field:=3, Criteria1:=Array("4025", _
        "4025-", "4025+", "4025MB"), Operator:=xlFilterValues   ' sostituire i valori con i codici degli altri articoli
    ActiveWindow.ScrollColumn = 2     '
    ActiveWindow.ScrollColumn = 3     ' non
    ActiveWindow.ScrollColumn = 4     '
    ActiveWindow.ScrollColumn = 5     ' so
    ActiveWindow.ScrollColumn = 6     '
    ActiveWindow.ScrollColumn = 7     ' a che
    ActiveWindow.ScrollColumn = 8     '
    ActiveWindow.ScrollColumn = 9     ' servono
    ActiveWindow.ScrollColumn = 10    '
    ActiveSheet.Range("$1:$UR").AutoFilter Field:=24, Criteria1:="<>"  ' per filtrare le righe vuote nelle celle contenenti Hr e T
    ActiveWindow.SmallScroll Down:=-15
   
'ciclo for per ripetere questa operazione per i valori trovati

    For RC = 1 To UR   ' RC= riga corrente  UR= ultima riga
    ActiveSheet.Range("$1:UR").AutoFilter Field:=24, Criteria1:="xxx"  ' far sostituire il valore di criteria1 dal ciclo
    Range("X2310:Y2310").Select  ' cosi da scorrere tutti i valori trovati dal filtro
    Selection.Copy         ' e copiarli nel file media peel
    Windows("Media peel.xlsx").Activate
    Sheets("4025").Select    ' il foglio in cui copiare i dati
    Range("ARC").Select   ' la cella da cui partire da deve essere A4   
    ActiveSheet.Paste    'ARC= A=colonna RC=riga corrente   ARC range (1, UR)
    Next RC
   
' fine ciclo for

    Windows("Tabella Prove Rotoli 2012.xls").Activate
End Sub


La macro deve riempire la colonna A e B dei fogli presenti nel file Media Peel.xlsx.
nella colonna A devono essere copiati tutti i valori di T(temperatura) prelevati dalla colonna X del file Tabella Prove Rotoli 2012.xlsx; nella colonna B devono essere copiati i valori univoci di Hr(Umidità) prelevati dalla colonna Y del suddetto file.

per capirci se ho una cosa del genere:

T Hr
20 50
20 51
20 50
21 50

la macro deve riportarmi

T Hr
20 50
20 51
21 50

se può bastare questo senza allegare il file di esempio meglio, altrimenti devo preparare un file d'esempio per rimuovere i dati non necessari ai fini dello sviluppo della macro.

Grazie a tutti
theterrible
Utente Junior
 
Post: 21
Iscritto il: 20/09/12 13:52

Sponsor
 

Re: [Excel] Copia combinazioni di dati

Postdi theterrible » 24/09/12 13:44

Mi fa piacere che 40 persone abbiano visualizzato il post ma che nessuno abbia dato una risposta.
Se ho mancato delle informazioni, o la mia richiesta risulta di difficile comprensione fatemelo sapere.

Grazie ancora a tutti
Ivan
theterrible
Utente Junior
 
Post: 21
Iscritto il: 20/09/12 13:52

Re: [Excel] Copia combinazioni di dati

Postdi Anthony47 » 25/09/12 10:24

Ciao theterrible, benvenuto nel forum.
Allora io ho capito che tu vuoi prendere dal file Tabella Prove Rotoli 2012.xlsx, foglio da specificare, le coppie "univoche" delle colonne X:Y e metterle in colonna A:B del file Media Peel.xlsx
Se e' cosi', allora prova una macro come questa, da inserire in un Modulo standard del file Media Peel.xlsx
Codice: Seleziona tutto
Sub GetData2()
'vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=97011
SourceWB = "Tabella Prove Rotoli 2012.xlsx" '<< Il file da cui prelevare
SourceSh = "Foglio1"    '<< Il foglio da cui prelevare
DataArea = "X:Y"        '<< Le colonne da prelevare
DestSh = "Foglio1"      '<< Il foglio su cui scrivere
'
ThisWorkbook.Activate
Sheets(DestSh).Select
Columns("A:B").Insert Shift:=xlToRight
Workbooks(SourceWB).Sheets(SourceSh).Range(DataArea).Copy _
    Destination:=Range("A1")
Application.CutCopyMode = False
Range("A:B").Select
Selection.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Selection.Copy Destination:=Range("C1")
ActiveSheet.ShowAllData
Columns("A:B").Delete Shift:=xlToLeft
Range("A1").Select
End Sub

Personalizza le righe marcate <<, in particolare il nome dei fogli da cui prelevare e su cui scrivere.
Poi esegui la macro e controlla il risultato.
Nota che sul foglio dove devi copiare, non sapendo se esso e' vuoto o gia' popolato di dati, vengono aggiunte inizialmente due nuove colonne A:B in cui incollo i dati provenienti dal file sorgente, prima di eliminare i doppioni; queste colonne verranno subito dopo eliminate, lasciando i dati univoci in A:B. Questo pero' comporta che se questo foglio e' gia' popolato di dati fino all' ultima colonna disponibile la macro andra' in errore; se questo e' il tuo caso allora "manipoleremo" il file di origine senza bisogno di aggiungere colonne sul file di destinazione.

Fai sapere, ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19221
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel] Copia combinazioni di dati

Postdi theterrible » 25/09/12 14:42

Buonasera, grazie Anthony della tua risposta.

Purtroppo il file è già popolato di formule, che utilizzano come variabili proprio i valori inseriti in A e B per calcolare la medie e il numero di prove effettuate per ogni articolo con altri dati presi dal file tabella prove rotoli.

Quindi dalla colonna C in poi io ho una serie di formule per ogni articolo che a seconda dei valori di umidità e temperatura inseriti nelle colonne A e B effettua delle ricerche sul file tabella prove rotoli e mi conta il numero di prove effettuate e la media del peel delle prove effettuate in quelle condizioni.

Grazie ancora.
theterrible
Utente Junior
 
Post: 21
Iscritto il: 20/09/12 13:52

Re: [Excel] Copia combinazioni di dati

Postdi Anthony47 » 25/09/12 14:51

[. . . ] Questo pero' comporta che se questo foglio e' gia' popolato di dati fino all' ultima colonna disponibile la macro andra' in errore; se questo e' il tuo caso allora "manipoleremo" il file di origine senza bisogno di aggiungere colonne sul file di destinazione
E' questo il tuo caso?
Avatar utente
Anthony47
Moderatore
 
Post: 19221
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel] Copia combinazioni di dati

Postdi theterrible » 25/09/12 14:55

Il file media peel ha già le colonne da C in poi occupati di formule e la macro deve copiare in A e B.
Il file tabella prove rotoli a colonne occupate da A ad AO e la macro deve prelevare i dati da X e Y.
theterrible
Utente Junior
 
Post: 21
Iscritto il: 20/09/12 13:52

Re: [Excel] Copia combinazioni di dati

Postdi Anthony47 » 25/09/12 15:04

Ma le tue formule occupano "fino all' ultima colonna disponibile" del tuo foglio??
Hai provato la soluzione proposta (sempre un su file di prova...)?
Come detto, "se questo foglio e' gia' popolato di dati fino all' ultima colonna disponibile la macro andra' in errore"...

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19221
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel] Copia combinazioni di dati

Postdi theterrible » 25/09/12 15:46

ho provato la macro con i file originali, e da un errore di runtime 9 , indice non trovato, effettuando un debug si ferma alla riga

Workbooks(SourceWB).Sheets(SourceSh).Range(DataArea).Copy _
Destination:=Range("A1")

ora stavo preparando dei file di prova con un po di dati da utilizzare per fare le prove ed eventualemte da inviarvi.
theterrible
Utente Junior
 
Post: 21
Iscritto il: 20/09/12 13:52

Re: [Excel] Copia combinazioni di dati

Postdi theterrible » 25/09/12 16:19

Ho provato la macro sui file di prova che ho creato; e come risultato ho solo un valore di temperatura e umidità copiati nel file media peel.

qui il link con l'archivio rar contenente i due file di prova creati

http://www.filedropper.com/mediapeel_1
theterrible
Utente Junior
 
Post: 21
Iscritto il: 20/09/12 13:52

Re: [Excel] Copia combinazioni di dati

Postdi Anthony47 » 25/09/12 18:02

Immagino che i dati da prelevare siano in col D:E del file tabellaproverotoli.xlsx
Adottando la macro che ti ho suggerito ho ottenuto 52 coppie di valori T-Hr
Immagine

Uploaded with ImageShack.us

Poiche' hai inviato mediapeel.xlsx senza la macro che ti avevo suggerito non posso vedere come l' hai implementata; il suggerimento e' quindi di riprovare seguendo le istruzioni, e se non risolvi invia il file mediapeel.xlsm (con la macro inserita e personalizzata).

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19221
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel] Copia combinazioni di dati

Postdi theterrible » 26/09/12 16:19

Ho provato la macro nuovamente sui file di prova, copia tutti i dati che interessano, ma il problema è che con l'aggiunta delle due colonne e la successiva rimozione le formule perdono i riferimenti delle celle A e B con cui effettuare i calcoli.

questa cosa come la risolvo??

Allego il file mediapeel con la macro.
http://www.filedropper.com/mediapeel_2
theterrible
Utente Junior
 
Post: 21
Iscritto il: 20/09/12 13:52

Re: [Excel] Copia combinazioni di dati

Postdi Anthony47 » 27/09/12 01:01

Il file che hai allegato stasera ha le formule in col C e col D gia' corrotte; in C4 e D4 risultano rispettivamente
Codice: Seleziona tutto
=MEDIA.PIÙ.SE([tabellaproverotoli.xlsx]prove!$C$2:$C$70;[tabellaproverotoli.xlsx]prove!$D$2:$D$70;#RIF!;[tabellaproverotoli.xlsx]prove!$E$2:$E$70;#RIF!)

=CONTA.PIÙ.SE([tabellaproverotoli.xlsx]prove!$F$2:$F$70;CONCATENA($C$1;$C$2);[tabellaproverotoli.xlsx]prove!$D$2:$D$70;#RIF!;[tabellaproverotoli.xlsx]prove!$E$2:$E$70;#RIF!)

Usando il file mediapeel di ieri, applicando la macro come da te allegata sul mediapeel di stasera ho ottenuto questo risultato:
Immagine

Uploaded with ImageShack.us

La macro in origine in realta' da' un errore quando si prova a incollare le coppie univoche in C3 (riga Selection.Copy Destination:=Range("C3")) segnalando che non si puo' incollare su celle unite; infatti su mediapeel in origine le celle A1:A3 e B1:B3 sono "unite". E' bastato disunirle per completare la macro e ottenere il risultato in figura.

Ripetendo le prove col file tabellaproverotoli.xlsx chiuso (una situazione che non dovrebbe accadere perche' altrimenti mancherebbe il file da cui copiare le coppie T-Hr) la macro va in errore segnalando "Indice non incluso nell' intervallo" perche' manca il workbook tabellaproverotoli.xlsx e le formule vengono corrotte.
Immagino quindi, anche tenendo presente la tua prima indicazione di macro in errore con l' errore "Indice non incluso nell' intervallo", che ti sei trovato nella stessa condizione.

Per evitare cio' puoi inserire nella macro le istruzioni che aprono tabellaproverotoli.xlsx se risulta chiuso; nell' ipotesi che questo file sia nella stessa directory di mediapeel bastera' aggiungere queste istruzioni:
Codice: Seleziona tutto
DestSh = "4025"      '<< Il foglio su cui scrivere
'AGGIUNGERE LE PROSSIME 4 RIGHE
On Error Resume Next
SecFName = Workbooks(SourceWB).Name
On Error GoTo 0
If SecFName = "" Then Workbooks.Open Filename:=ThisWorkbook.Path & "\" & SourceWB
'
ThisWorkbook.Activate     'GIA' PRESENTE nella macro precedente
'etc etc

Ciao, fai sapere.
Avatar utente
Anthony47
Moderatore
 
Post: 19221
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel] Copia combinazioni di dati

Postdi theterrible » 28/09/12 13:24

27/09/12 02:01 <<< non riuscivi a dormire è hai cercato una soluzione al mio problema?? Non dovevi!!

Apparte gli scherzi, il file che avevo allegato era il risultato di mediapeel dopo aver modificato la macro e il file originale affinche essa potesse funzionare, disunendo le celle A1:A3 e B1:B3 e modificando la macro per la scrittura dei dati da A3. dopo aver provveduto a queste modifiche ho eseguito la macro e il mio risultato è il fiel che poi ho inviato, con le formule corrotte.

Proverò nuovamente ad effettuare le modifiche e verificare che le formule siano corrette prima di eseguire nuovamente la macro; non credo di aver dimenticato il file tabellaproverotoli chiuso in quanto sono a conoscenza del fatto che esso deve essere aperto per poter consentire al file mediapeel di calcolare le medie e i conti; però tutto può essere.

Aggiungerò il codice sotto ed effettuerò delle prove.

Già che ci siamo volevo chiederti se quello che avevo iniziato io non serve a nullo o può essere sviluppato per raggiungere gli stessi scopi?? Giusto per soddisfazione personale, cosi posso dire che parte della macro lo sviluppata io.

Ciao e grazie ancora.
theterrible
Utente Junior
 
Post: 21
Iscritto il: 20/09/12 13:52

Re: [Excel] Copia combinazioni di dati

Postdi Anthony47 » 29/09/12 01:41

Nel tuo codice non ho afferrato con quale algoritmo stavi creando le coppie di valori unici, che nel codice che ti ho fornito viene fatto dal comando AdvancedFilter; sinceramente non saprei suggerire come completarlo.
Comunque e' giusto l' approccio di registrare una macro per ottenere uno scheletro da perfezionare.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19221
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel] Copia combinazioni di dati

Postdi theterrible » 01/10/12 10:36

Buongiorno,

per rispondere alla tua domanda anthony, nel codice che ho creato io, non ero ancora arrivato alla procedura per effettuare la copia delle coppie univoche, ed e qui che volevo il vostro aiuto; io infatti attraverso la registrazione macro avevo effettuato i comandi da eseguire, applicazione del filtro sul campo codice, applicazione del filtro sulla campo temperatura cosi da eliminare le celle vuote, e poi a quel punto avevo inserito un ciclo for per la copia dei dati, ed era proprio quello che mi mancava.

In relazione a questo ho applicato la macro da te creata al file originale contenenti tutti le prove rotoli e il file media peel con altri colonne occupate e questa volta la macro non si blocca ma, i valori che copia sono troppi, molto probabilmente la macro copia tutti i valori univoci di temperatura e umidità presenti nella tabella prove rotoli e li riporta nel file media peel.

In realtà la macro dovrebbe copiare solo le coppie relative hai vari articoli che sono 5 diversi (4025,4030,4035, 4925, 4930); come puoi vedere da questa riga della mia macro

Codice: Seleziona tutto
ActiveSheet.Range("$1:UR").AutoFilter Field:=3, Criteria1:=Array("4025", _
        "4025-", "4025+", "4025MB"), Operator:=xlFilterValues   ' sostituire i valori con i codici degli altri articoli


Se hai bisogno dei file originali per lavorare a questo fammelo sapere che li allego al prossimo messaggio.

Per il momento ti ringrazio nuovamente.
theterrible
Utente Junior
 
Post: 21
Iscritto il: 20/09/12 13:52

Re: [Excel] Copia combinazioni di dati

Postdi Anthony47 » 02/10/12 01:30

molto probabilmente la macro copia tutti i valori univoci di temperatura e umidità presenti nella tabella prove rotoli e li riporta nel file media peel
Si, e' cosi', come ti dissi esplicitamente nella mia prima risposta:
Allora io ho capito che tu vuoi prendere dal file Tabella Prove Rotoli 2012.xlsx, foglio da specificare, le coppie "univoche" delle colonne X:Y e metterle in colonna A:B del file Media Peel.xlsx
Se e' cosi', allora etc etc

E mi pare che proprio questa fosse la tua richiesta:
La macro deve riempire la colonna A e B dei fogli presenti nel file Media Peel.xlsx.
nella colonna A devono essere copiati tutti i valori di T(temperatura) prelevati dalla colonna X del file Tabella Prove Rotoli 2012.xlsx; nella colonna B devono essere copiati i valori univoci di Hr(Umidità) prelevati dalla colonna Y del suddetto file.


Ora spieghi che vorresti invece fare un filtro anche sugli articoli; ti chiedo pero' di chiarire se i codici di tuo interesse sono 5 fissi o se invece e' un elenco che deve variare (e come).

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19221
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel] Copia combinazioni di dati

Postdi theterrible » 02/10/12 10:46

Buongiorno,
mi scuso per essermi spiegato male, e aver cosi fatto perdere tempo alla risoluzione del mio problema.
Nel codice della macro che avevo fatto io c'èra l'indicazione del filtro da applicare come da mio messaggio di ieri; ma va bene cosi.

ActiveSheet.Range("$1:UR").AutoFilter Field:=3, Criteria1:=Array("4025", _
"4025-", "4025+", "4025MB"), Operator:=xlFilterValues ' sostituire i valori con i codici degli altri articoli


La macro da te sviluppata l'ho inserite nei vari fogli che compongono il file mediapeel e hanno i nomi degli articoli indicati sempre nel mio ultimo messaggio
(4025,4030,4035, 4925, 4930);
poi ho creato una routine che richiama le varie macro e che si attiva all'apertura del file mediapeel, cosi che quando viene aperto automaticamente apre il file tabella prove rotoli, ne copia le coppie univoche di temperatura e umidità e poi li ordina dal più piccolo al più grande, tutto questo per i 5 fogli/articoli che mi interessano.

L'unico problema e qui errore mio che mi sono spiegato male nel primo messaggio è che la macro copia tutti i valori e non solo quelli relativi all'articolo che mi interessa.

Stamani volevo inserire il codice:
Codice: Seleziona tutto
ActiveSheet.Range("$1:UR").AutoFilter Field:=3, Criteria1:=Array("4025", _
        "4025-", "4025+", "4025MB"), Operator:=xlFilterValues


cosi da verificare se la macro copia solo i valori di T e Hr che mi interessano, se è cosi copio la riga sopra nelle altre macro e il problema è risolto.

Ti ringrazio nuovamente ti farò sapere se il cosice funziona e posterò anche il codice finale della macro per usi futuri.
theterrible
Utente Junior
 
Post: 21
Iscritto il: 20/09/12 13:52

Re: [Excel] Copia combinazioni di dati

Postdi theterrible » 02/10/12 12:05

Ho provato ad inserire il codice per applicare il filtro, e una sola volta mentre stavo facendo delle modifiche ho avuto il risultato che volevo, derminate le modifiche e reso la macro allo stato definitivo questa non da più il risultato desiderato e rimane bloccata per diversi minuti fino a quando non chiudo excel e lo riapro.

Codice: Seleziona tutto
Sub CopiaTHr4025()
'vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=97011
SourceWB = "Tabella Prove Rotoli 2012.xls" '<< Il file da cui prelevare
SourceSh = "TOTALE"    '<< Il foglio da cui prelevare
DataArea = "X:Y"        '<< Le colonne da prelevare
DestSh = "4025"      '<< Il foglio su cui scrivere
On Error Resume Next
SecFName = Workbooks(SourceWB).Name
On Error GoTo 0
If SecFName = "" Then Workbooks.Open Filename:=ThisWorkbook.Path & "\" & SourceWB
'
ThisWorkbook.Activate
Sheets(DestSh).Select
Columns("A:B").Insert Shift:=xlToRight
Workbooks(SourceWB).Sheets(SourceSh).Columns("C").AutoFilter Field:=3, Criteria1:=Array("4025", _  <<<< riga aggiunta da me
        "4025-", "4025+", "4025MB"), Operator:=xlFilterValues      <<< per attivare il filtro sulla colonna dove è presente il rifmac
Workbooks(SourceWB).Sheets(SourceSh).Range(DataArea).Copy _
    Destination:=Range("A1")
Application.CutCopyMode = False
Range("A:B").Select
Selection.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Selection.Copy Destination:=Range("C2")
ActiveSheet.ShowAllData
Columns("A:B").Delete Shift:=xlToLeft
Range("A2").Select
Call Ordina
End Sub
Sub Ordina()
URA = Range("A" & Rows.Count).End(xlUp).Row
    Range("A4:B" & URA).Select
    Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
End Sub


EDIT: mentre stavo scrivendo il messaggio la macro si è conclusa, ma il tempo impiegato è molto, dopo pranzo la rilancio e senza chiuderla verifico il tempo necessario per completarla.
theterrible
Utente Junior
 
Post: 21
Iscritto il: 20/09/12 13:52

Re: [Excel] Copia combinazioni di dati

Postdi theterrible » 02/10/12 13:28

Rieccomi,
ho lanciato la macro sopra e ha impiegato 7 minuti a completarsi su un pc dual core con 4gb di ram. Sono un po tanti, contando che ho creato una macro che richiama le varie macro inserite nei vari fogli di media peel, e quando passa alla seconda restituisce un errore di risorse insufficienti per eseguire le operazioni richieste.

Da qui deduco che il codice sopra ha bisogno di uno snellimento.

Dato che chi mi sta seguendo, Anthony, normalmente mi scrive la notte e che io prima di domani non vedo la risposta; per velocizzare il tutto allego i file originali tabella prove rotoli e media peel , su quest'ultimo sono presenti le macro CopiaTHr4025 e CopiaTHr4030 e la macro mediapeel che le richiama entrambe.

link per scaricare i file : http://www.filedropper.com/mediapeeldef

A domani per gli aggiornamenti.
Saluti
Ivan
theterrible
Utente Junior
 
Post: 21
Iscritto il: 20/09/12 13:52

Re: [Excel] Copia combinazioni di dati

Postdi Anthony47 » 03/10/12 01:47

In prima battuta ho modificato la selezione prima dell' advanced filtro, a me ha ridotto i tempi a circa 18 secondi per articolo:
Codice: Seleziona tutto
Application.CutCopyMode = False
Range("A1:B20000").Select        '<<< Modifica questa riga
Selection.AdvancedFilter Action:=xlFilterInPlace, Unique:=True

Mi e' sembrato un risultato decoroso e ho avuto la tentazione di lasciarla cosi'.

Tuttavia l' analisi dei tempi macro ha evidenziato come anche cosi' oltre il 75% e' speso nell' inserimento colonne aggiuntive, ricerca dei valori unici tramite AdvancedFilter, cancellazione delle colonne aggiunte; ho voluto quindi provare una soluzione che non aggiunge colonne ma usa DUE COLONNE LIBERE nei singoli fogli, e non usa AdvancedFilter per il calcolo dei valori unici ma la tecnica del data Dictionary.
I risultati sono abbastanza buoni, cioe' migliore dei 18 secondi della prima soluzione.
La macro e' la seguente
Codice: Seleziona tutto
Sub CopiaTHr4025Bis()
'vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=97011
sourcewb = "Tabella Prove Rotoli 2012.xls" '<< Il file da cui prelevare
sourcesh = "TOTALE"    '<< Il foglio da cui prelevare
DataArea = "X:Y"        '<< Le colonne da prelevare
DestSh = "4025"      '<< Il foglio su cui scrivere
Libera = "AG1"       '<<<<<<<< Area del foglio con 2 colonne libere adiacenti

On Error Resume Next
SecFName = Workbooks(sourcewb).Name
On Error GoTo 0
If SecFName = "" Then Workbooks.Open Filename:=ThisWorkbook.Path & "\" & sourcewb
'
ThisWorkbook.Activate
Sheets(DestSh).Select
'[T1] = Timer
'Columns("A:B").Insert Shift:=xlToRight
'[T2] = Timer
Workbooks(sourcewb).Sheets(sourcesh).Columns("C").AutoFilter Field:=3, Criteria1:=Array("4025", _
        "4025-", "4025+", "4025MB"), Operator:=xlFilterValues
'[T3] = Timer
Workbooks(sourcewb).Sheets(sourcesh).Range(DataArea).Copy _
    Destination:=Range(Libera)
Application.CutCopyMode = False
'[T4] = Timer

'== Ricerca via dictionary dei valori unici
Last2A = Range(Libera).Offset(65000, 0).End(xlUp).Row
Dim Varr2XY, myUnic()
ReDim myUnic(1 To Last2A, 1 To 2)
Dim myD
Set myD = CreateObject("Scripting.Dictionary") 'Modalita' Late Binding
myD.RemoveAll   ' Clear del dictionary
Range("A4:B65000").ClearContents
Varr2XY = Range(Libera).Resize(Last2A, 2)
J = 1
For I = LBound(Varr2XY, 1)  To UBound(Varr2XY, 1)
    If Not myD.exists(Varr2XY(I, 1) & "-" & Varr2XY(I, 2)) Then
        myD.Add (Varr2XY(I, 1) & "-" & Varr2XY(I, 2)), 22
'        If Varr2XY(I, 1) <> "" Then
            myUnic(J, 1) = Varr2XY(I, 1)
            myUnic(J, 2) = Varr2XY(I, 2)
            J = J + 1
'        End If
    End If
Next I
'end
'==
'Selection.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
'Selection.Copy Destination:=Range("C2")
Range("A2:B" & Last2A).Value = myUnic()     
'[T5] = Timer
'ActiveSheet.ShowAllData
Range(Libera).Resize(65000, 2).Clear
'Columns("A:B").Delete Shift:=xlToLeft
'[T6] = Timer
Set myD = Nothing
Range("A2").Select
Call Ordina
'[T7] = Timer
End Sub
Nota la presenza di una ulteriore definizione, in testa, riga marcata <<<<<<; essa dichiara quale e' la prima delle due colonne adiacenti libere che saranno usate al posto delle 2 colonne che prima si aggiungevano alla sinistra.
Ho lasciato visibili ma inoperative alcune delle istruzioni precedenti per mostrare le principali variazioni, come pure si intravedono i cronometri inseriti per prova nella macro per misurare i colli di bottiglia.

Prova con questa versione e fai sapere.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19221
Iscritto il: 21/03/06 16:03
Località: Ivrea

Prossimo

Torna a Applicazioni Office Windows


Topic correlati a "[Excel] Copia combinazioni di dati":


Chi c’è in linea

Visitano il forum: papiriof e 55 ospiti