AIUTO PER SNELLIRE MACRO

Hai un problema con Excel?

Nuova discussione

AIUTO PER SNELLIRE MACRO
di leonardocarrani data: 04/12/2013 12:36:44
Salve a tutti,
questa è la mia prima discussione e ne approfitto di questo forum per chiedervi un aiuto.
Premetto che non ci capiso niente nella scrittura delle macro ed ho realizzato quelle seguenti utilizzando quasi eclusivamente il registratore di macro, ad eccezzione di qualche modifica che ho fatto.
La macro che ne risulta è un lenzuolo impressionante, che però funziona!
Il problema è che excel è rallentatissimo e mi blocca anche altre applicazioni.
Qualcuno di voi potrebbe aiutarmi a snellire la macro che sicuramente sarà piena di ridondanze?
Vi ringrazio anticipatamente per il tempo che vorrete dedicarmi.
Leonardo

Sub Macro1()
'
' Macro1 Macro
'
' Scelta rapida da tastiera: CTRL+a
'
    Sheets("DATI DA ELABORARE").Select
    Sheets("DATI DA ELABORARE").Name = "DATI DA ELABORARE"
    Sheets("DATI DA ELABORARE").Select
    ActiveWorkbook.Worksheets("DATI DA ELABORARE").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DATI DA ELABORARE").AutoFilter.Sort.SortFields.Add _
        Key:=Range("A6:A1048576"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("DATI DA ELABORARE").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("DATI DA ELABORARE").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DATI DA ELABORARE").AutoFilter.Sort.SortFields.Add _
        Key:=Range("B6:B1048576"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("DATI DA ELABORARE").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A$6:$E$1048576").AutoFilter Field:=3, Criteria1:=Array( _
        "01.001.1", "01.001.3", "01.001.4", "01.002.2", "01.003.1", "01.003.3", "01.003.4", _
        "01.003.8", "01.004.2", "01.004.3", "01.004.4", "01.006.3", "01.006.4", "01.006.5", _
        "01.006.6", "01.008.1", "01.008.3", "01.008.4", "01.010.3", "01.010.4", "01.010.5", _
        "01.010.6", "01.012.3", "01.012.4", "01.013.3", "01.013.4", "01.014.3", "01.014.4", _
        "01.015.3", "01.015.4", "01.016.1", "01.016.3", "01.016.4", "01.016.8", "01.017.3", _
        "01.017.4", "01.018.1", "01.018.3", "01.018.4", "01.018.5", "01.018.8", "01.019.4", _
        "01.019.5", "01.020.4", "01.021.3", "01.102.1", "01.102.2", "01.102.3", "01.103.1", _
        "01.103.2", "01.103.3", "01.103.4", "01.103.5", "01.103.6", "01.104.1", "01.104.3", _
        "01.104.4", "01.104.6", "01.105.2", "01.105.3", "01.107.3", "01.107.4", "01.108.2", _
        "01.110.1", "01.110.4", "01.111.2", "01.111.3", "01.113.1", "01.160.1", "01.160.2", _
        "01.160.3", "01.160.4", "01.165.1", "01.165.2", "01.165.3", "01.165.4", "01.182.1", _
        "01.182.2", "01.201.4", "01.201.5", "01.201.6", "01.201.7", "01.205.3", "01.205.7"), _
        Operator:=xlFilterValues
    Range("A7").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.Run "COPIA_SOLO_CELLE_VISIBILI"
    Selection.Copy
    Sheets("1a ELABORAZIONE").Select
    Range("A7").Select
    ActiveSheet.Paste
    ActiveSheet.Range("$F$6:$I$1048576").AutoFilter Field:=1, Criteria1:="<>"
    Range("A7:E7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.Run "COPIA_SOLO_CELLE_VISIBILI"
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("DATI SMN").Select
    Range("A7").Select
    ActiveSheet.Paste
    Sheets("1a ELABORAZIONE").Select
    ActiveSheet.Range("$F$6:$I$1048576").AutoFilter Field:=1
    ActiveSheet.Range("$F$6:$I$1048576").AutoFilter Field:=2, Criteria1:="<>"
    Range("A7:E7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.Run "COPIA_SOLO_CELLE_VISIBILI"
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("DATI SMN").Select
    Range("A7").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    ActiveWorkbook.Worksheets("DATI SMN").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DATI SMN").AutoFilter.Sort.SortFields.Add Key:= _
        Range("A6"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("DATI SMN").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("DATI SMN").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DATI SMN").AutoFilter.Sort.SortFields.Add Key:= _
        Range("B6"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("DATI SMN").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("DATI SMN").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DATI SMN").AutoFilter.Sort.SortFields.Add Key:= _
        Range("D6"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("DATI SMN").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("1a ELABORAZIONE").Select
    ActiveSheet.Range("$F$6:$I$1048576").AutoFilter Field:=2
    ActiveSheet.Range("$F$6:$I$1048576").AutoFilter Field:=3, Criteria1:="<>"
    Range("A7:E7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.Run "COPIA_SOLO_CELLE_VISIBILI"
    Selection.Copy
    Sheets("DATI VCO").Select
    Range("A7").Select
    ActiveSheet.Paste
    Sheets("1a ELABORAZIONE").Select
    ActiveSheet.Range("$F$6:$I$1048576").AutoFilter Field:=3
    ActiveSheet.Range("$F$6:$I$1048576").AutoFilter Field:=4, Criteria1:="<>"
    Range("A7:E7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.Run "COPIA_SOLO_CELLE_VISIBILI"
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("DATI VCO").Select
    Range("A7").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    ActiveWorkbook.Worksheets("DATI VCO").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DATI VCO").AutoFilter.Sort.SortFields.Add Key:= _
        Range("A6"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("DATI VCO").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("DATI VCO").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DATI VCO").AutoFilter.Sort.SortFields.Add Key:= _
        Range("B6"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("DATI VCO").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("DATI VCO").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DATI VCO").AutoFilter.Sort.SortFields.Add Key:= _
        Range("D6"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("DATI VCO").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("1a ELABORAZIONE").Select
    ActiveSheet.Range("$F$6:$I$1048576").AutoFilter Field:=4
    Range("A7:E7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Sheets("DATI DA ELABORARE").Select
    ActiveSheet.Range("$F$6:$I$1048576").AutoFilter Field:=3
    Range("A7:E7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Sheets("CARICARE I PRIMI DATI").Select
    Range("A1:E1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
End Sub

di Grograman (utente non iscritto) data: 04/12/2013 12:50:29
Il file che utilizza questo codice è visionabile?
di isy data: 04/12/2013 12:54:52
Ciao leonardocarrani

In questo codice potresti disabilitare gli eventi come ricalcolo rinfresco dello schermo ecc

Per poter esser certi che questi suggerimenti si possono utilizzare nel tuo codice chiedo di allegare un file d'esempio.
Elimina eventuali dati sensibili, ricordati di allegare l'intero progetto e non solo una parte.
se utilizzi ad esempio: Application.Run "COPIA_SOLO_CELLE_VISIBILI"
la chiamata del codice sarà più lenta che non eseguito nella stessa SUB
di patel data: 04/12/2013 18:00:53
bisognerebbe anche capire qual'è lobiettivo della macro, partendo dal foglio iniziale cosa si vuole ottenere ? magari bastano 10 righe di codice
di leonardo (utente non iscritto) data: 05/12/2013 16:25:55
Vorrei allegare il file per farvelo visionare ma le sue dimensioni anche con pochi dati inseriti si aggirano intorno ai 150mb.
di leonardocarrani (utente non iscritto) data: 05/12/2013 17:27:42
Il file excel è formato da 5 fogli:
1) "DATI DA ELABORARE"
2) "1a ELABORAZIONE"
3) "DATI SMN"
4) "DATI VCO"
5) "TABELLA SEMAFORI"

in "DATI DA ELABORARE" ci sono 5 colonne
"ORA" "DATA" "COD1" "COD2" e "COD3"
importo i dati da esterno e faccio partire la "Macro1".
La "Macro1" filtra la colonna "COD1" e copia le sole celle visibili da "A7" ad "E?????" nel foglio "1a ELABORAZIONE".
Nel foglio "1a ELABORAZIONE" ci sono 9 colonne, di cui 5 sono le stesse del foglio precedente, la A, B, C, D, E, mentre le colonne F, G, H, I contengono ciascuna una serie di formule SE come la seguente:
=SE(E(C7=" 01.201.7";E7=0;C8=" 01.001.1";E8=1);"OK";SE(E(C7=" 01.001.1";E7=1;C6=" 01.201.7";E6=0);"OK";SE(E(C7=" 01.001.1";E7=0;C8=" 01.001.3";E8=1);"OK";SE(E(C7=" 01.001.3";E7=1;C6=" 01.001.1";E6=0);"OK";SE(E(C7=" 01.001.3";E7=0;C8=" 01.003.1";E8=1);"OK";SE(E(C7=" 01.003.1";E7=1;C6=" 01.001.3";E6=0);"OK";SE(E(C7=" 01.003.1";E7=0;C8=" 01.003.3";E8=1);"OK";SE(E(C7=" 01.003.3";E7=1;C6=" 01.003.1";E6=0);"OK";SE(E(C7=" 01.003.3";E7=0;C8=" 01.004.3";E8=1);"OK";SE(E(C7=" 01.004.3";E7=1;C6=" 01.003.3";E6=0);"OK";SE(E(C7=" 01.004.3";E7=0;C8=" 01.102.1";E8=1);"OK";SE(E(C7=" 01.102.1";E7=1;C6=" 01.004.3";E6=0);"OK";SE(E(C7=" 01.102.1";E7=0;C8=" 01.102.3";E8=1);"OK";SE(E(C7=" 01.102.3";E7=1;C6=" 01.102.1";E6=0);"OK";SE(E(C7=" 01.160.1";E7=1;C6=" 01.102.3";E6=0);"OK";SE(E(C7=" 01.160.1";E7=0;C8=" 01.160.3";E8=1);"OK";SE(E(C7=" 01.160.3";E7=1;C6=" 01.160.1";E6=0);"OK";SE(E(C7=" 01.160.3";E7=0;C8=" 01.103.1";E8=1);"OK";SE(E(C7=" 01.103.1";E7=1;C6=" 01.160.3";E6=0);"OK";SE(E(C7=" 01.103.1";E7=0;C8=" 01.103.3";E8=1);"OK";SE(E(C7=" 01.103.3";E7=1;C6=" 01.103.1";E6=0);"OK";SE(E(C7=" 01.103.3";E7=0;C8=" 01.103.5";E8=1);"OK";SE(E(C7=" 01.103.5";E7=1;C6=" 01.103.3";E6=0);"OK";SE(E(C7=" 01.103.5";E7=0;C8=" 01.165.1";E8=1);"OK";SE(E(C7=" 01.165.1";E7=1;C6=" 01.103.5";E6=0);"OK";SE(E(C7=" 01.165.1";E7=0;C8=" 01.165.3";E8=1);"OK";SE(E(C7=" 01.165.3";E7=1;C6=" 01.165.1";E6=0);"OK";SE(E(C7=" 01.165.3";E7=0;C8=" 01.104.1";E8=1);"OK";SE(E(C7=" 01.104.1";E7=1;C6=" 01.165.3";E6=0);"OK";SE(E(C7=" 01.104.1";E7=0;C8=" 01.104.3";E8=1);"OK";SE(E(C7=" 01.104.3";E7=1;C6=" 01.104.1";E6=0);"OK";SE(E(C7=" 01.104.3";E7=0;C8=" 01.105.3";E8=1);"OK";SE(E(C7=" 01.105.3";E7=1;C6=" 01.104.3";E6=0);"OK";SE(E(C7=" 01.105.3";E7=0;C8=" 01.006.3";E8=1);"OK";SE(E(C7=" 01.006.3";E7=1;C6=" 01.105.3";E6=0);"OK";SE(E(C7=" 01.006.3";E7=0;C8=" 01.006.5";E8=1);"OK";SE(E(C7=" 01.006.5";E7=1;C6=" 01.006.3";E6=0);"OK";SE(E(C7=" 01.006.5";E7=0;C8=" 01.107.3";E8=1);"OK";SE(E(C7=" 01.107.3";E7=1;C6=" 01.006.5";E6=0);"OK";SE(E(C7=" 01.107.3";E7=0;C8=" 01.008.1";E8=1);"OK";SE(E(C7=" 01.008.1";E7=1;C6=" 01.107.3";E6=0);"OK";SE(E(C7=" 01.008.1";E7=0;C8=" 01.008.3";E8=1);"OK";SE(E(C7=" 01.008.3";E7=1;C6=" 01.008.1";E6=0);"OK";SE(E(C7=" 01.008.3";E7=0;C8=" 01.010.3";E8=1);"OK";SE(E(C7=" 01.010.3";E7=1;C6=" 01.008.3";E6=0);"OK";SE(E(C7=" 01.102.3";E7=0;C8=" 01.160.1";E8=1);"OK";""))))))))))))))))))))))))))))))))))))))))))))))

Questo è l'unico modo per selezionare i dati che mi servivano che poi vengono copiati ed incollati nel foglio "DATI SMN" quelli delle colonne F, G mentre sul foglio "DATI VCO" quelli delle colonne H, I
Nel foglio "TABELLA SEMAFORI" ci sono una serie di tabelle con formule che utilizzano i dati dei fogli "DATI SMN" e "DATI VCO"
di leonardocarrani (utente non iscritto) data: 06/12/2013 08:48:22
Proviamo a cambiare....

Cosa dovrei scrivere nella macro per ottenere quanto segue?

Copia i dati delle celle A B C D E se la cella F è piena.
Andrebbe fatto per tutte le righe presenti nel foglio a partire dalla riga 7

Grazie...
di leonardocarrani data: 09/12/2013 08:24:29
Ciao...
Nessuno mi può aiutare?

Grazie...
Leonardo
di paolomath data: 09/12/2013 09:28:28
Ciao,

non entro nel merito della funzione del tuo codice. L'hai fatta con l'autocomposizione Macro. Ci sono ripetizione e selezioni inutili.

Ad esempio invece di:

Range("A7:E7").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

potresti mettere semplicemente:

Range("A7:E" & ActiveSheet.Rows.Count).ClearContents

Invece di:

Sheets("DATI DA ELABORARE").Select
Sheets("DATI DA ELABORARE").Name = "DATI DA ELABORARE"
Sheets("DATI DA ELABORARE").Select
ActiveWorkbook.Worksheets("DATI DA ELABORARE").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("DATI DA ELABORARE").AutoFilter.Sort.SortFields.Add _
Key:=Range("A6:A1048576"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("DATI DA ELABORARE").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Worksheets("DATI DA ELABORARE").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("DATI DA ELABORARE").AutoFilter.Sort.SortFields.Add _
Key:=Range("B6:B1048576"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("DATI DA ELABORARE").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Dovrebbe bastare:

Sheets("DATI DA ELABORARE").Select
ActiveWorkbook.Worksheets("DATI DA ELABORARE").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("DATI DA ELABORARE").AutoFilter.Sort.SortFields.Add _
Key:=Range("A6:A1048576"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("DATI DA ELABORARE").AutoFilter.Sort.SortFields.Add _
Key:=Range("B6:B1048576"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("DATI DA ELABORARE").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Buon divertimento...

Bye bye
di scossa data: 09/12/2013 09:39:54
Cit "....potresti mettere semplicemente:
Range("A7:E" & ActiveSheet.Rows.Count).ClearContents
"

Vorrei solo precisare, per i meno addentro, che Rows.Count è un valore che NON dipende dal foglio, nel senso che TUTTI i fogli hanno lo stesso numero di righe, quindi premettere ActiveSheet è ininfluente (mentre, personalmente, non omettere il parent di Range)
di leonardocarrani data: 09/12/2013 09:52:00
Grazie paolomath e Scossa...
Grazie
veramente...
Effettivamente, come avevo scritto nel primo post, essendo totalmente all'oscuro di VBA (ma mi piacerebbe cominciare a capirci), ho fatto tutto con REGISTRAZIONE MACRO e poi ho modificato qualcosa sbirciando quà e là sui vari forum...
a questo punto ne approfitto per chiedervi quanto segue, che probabilmente è un'ulteriore alleggerimento...

Vorrei copiare le celle A B C D E di tutte le righe se la cella F corrispondente alla righa controllata contiene "OK" ed incollarle in un altro foglio che si chiama "PIPPO"

sono partito provando a scrivere qualcosa ma mi sono bloccato perchè non so come far fare questo controllo a tutte le righe....
Sheets ("1a ELABORAZIONE") If Range ("F7")="OK" Then Range ("A7:E7").Select

di patel data: 09/12/2013 17:00:42
così

with Sheets ("1a ELABORAZIONE")
for r=1 to numerorighe
  If .Range ("F" & r)="OK" Then
     tuo codice
  end if
next
end with

Vuoi Approfondire?