Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Velocizzare macro per scorrere le righe

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

Velocizzare macro per scorrere le righe

Postdi ikwae » 27/02/20 22:57

Ciao a tutti,
ho recuperato qua e la qualche linea di codice, che a "naso" :oops: potesse andare bene
e ho "assemblato" questa macro “casareccia” è molto lenta, ma funziona al 100%.

Grossolanamente la macro cerca riga per riga il dato (il 2) sul tabellone del foglio “Uso”
e confrontando se questo dato “appartiene” alla ruota prestabilita in quel momento memorizzata.
Se la ruota appena letta è diversa dalla ruota memorizzata continua verso l’altro dato stessa riga.
Se la ruota è uguale alla ruota memorizzata recupera il Codice il Concorso e la Ruota che ha
generato il 2. I parametri raccolti vengono concatenati e, unite altre voci, vengono
scritte, accodandole, nella personale colonna del foglio “Tabella”.
Dico personale colonna perché ogni riga del tabellone ha una sua propria colonna.
Quindi 626 righe (dalla 7à alla 632) in 626 colonne (dalla A alla XB).
Ogni riga viene letta 11 volte e a conteggi fatti 632x11= è molto lenta!
Quindi chiedo aiuto per modificare la mia macro oppure farne una nuova al fine di
velocizzare i cicli di lettura. Se può bastare, a non far perdere tempo a chi mi aiuta, ho
cercato di inserire le voci di cosa fa ogni linea di codice per evitare di aprire l’allegato.

Per evitare il “tema” allego un file con quattro fogli:
.1) Foglio “Uso” con il tabellone volutamente ridotto in colonne (l’originale ne ha 900 in aumento)
.2) Foglio “Tabella” dove scrivere i dati raccolti.
.3) Foglio “Info” dove è specificata dettagliatamente la procedura della macro per eventuali modifiche.
.4) Foglio “Fine” è quello che si desidera ottenere con l’aiuto richiesto.

Ringraziando anticipatamente tutti coloro che mi daranno un aiuto. 73 ikwae

http://www.filedropper.com/594autotizza ... croperrete

Codice: Seleziona tutto
Sub Dati_In_Colonna_Ambo_Terno()
Sheets("Tabella").Select
range("A2:XB200").ClearContents
Sheets("Uso").Select
Dim rng As range
Dim N As Integer
Dim P As Integer
Dim c As Integer
Dim r As Integer

Application.ScreenUpdating = False
c = 1 'Contatore per colonna (dalla colonna A alla colonna XB)
r = 7 'Contatore per intervallo range (dalla riga 7 alla riga 632)

For N = 1 To 626 '626 giri (ogni giro scansiona 11 volte la stessa riga 626x11= è lenta!)

'Scrive le ruote che servono di volta in volta al Mid
'(alternativa "casareccia" all'IF per il confronto della ruota)
range("A634") = "Bari"
range("A635") = "Cagliari"
range("A636") = "Firenze"
range("A637") = "Genova"
range("A638") = "Milano"
range("A639") = "Napoli"
range("A640") = "Palermo"
range("A641") = "Roma"
range("A642") = "Torino"
range("A643") = "Venezia"
range("A644") = "Rn"

For P = 1 To 11 'Contatore interno 11 volte (una per ruota)
 dato = 2 'valore per ambo
'dato = 3 'valore per terno

'Range di ricerca è indispensabile una riga per volta
Set rng = range(Cells(r, 2), Cells(r, 2).End(xlToRight))

'cerco nel range il dato
For Each CL In rng
If CL = dato Then

'seleziono la cella
CL.Select

'Recupero i dati necessari (fondamentali per la specifica cinquina)
Codice = ActiveCell.EntireRow.Cells(1)   'codice   col A:A
conc = ActiveCell.EntireColumn.Cells(5)  'Concorso riga 5
ruota = ActiveCell.EntireColumn.Cells(6) 'ruota    riga 6
 
'Confronto che la ruota sia quella giusta altrimenti continua
If ruota = Mid([A634].Value, 1) Then Else GoTo 10  '<<<<<<<Questo è il Mid
 
'Se la ruota è giusta concatena i dati raccolti e altre aggiunte
Ambo = Codice & " - " & conc & " " & "ambo" & " " & ruota
'Terno = Codice & " - " & conc & " " & "TERNO" & " " & ruota

'Seleziono il foglio dove scaricare i dati
Sheets("Tabella").Select

'Trovo la colonna, è fondamentale una per riga, dove scaricare i dati
Dim bRow As Integer 'Dichiarazione ciclo per la prima cella vuota
bRow = 2 'A partire dalla riga 2
While Cells(bRow, c).Value <> "" 'Se la cella ora letta è occupata
bRow = bRow + 1  'si scala di riga incrementando di 1 il numero di riga
Wend   'quando si trova una cella libera
Cells(bRow, c).Select  'viene selezionata
 
'Scarico i dati raccolti
ActiveCell.Value = Ambo
'ActiveCell.Value = Terno
End If

'Si ritorna al foglio tabellone
Sheets("Uso").Select

10 'Nel caso che la ruota del Mid non è uguale alla ruota del dato
Next 'Ritorno della scelta riga in colonana

'Cancello una ruota tirandola su(per la memorizzazione del Mid)
range("A634").Select
Selection.Delete Shift:=xlUp

Next P  ' 'Fino a 11 Contatore interno un giro per ogni ruota
c = c + 1 'Fino a 626 incrementa il contatore di colonna
r = r + 1 'Fino a 632 incrementa il contatore del range(parte dalla riga 7)
Next N   'Fino a 626
Application.ScreenUpdating = True
End Sub
Excel 2007
Avatar utente
ikwae
Utente Senior
 
Post: 154
Iscritto il: 27/12/17 23:14

Sponsor
 

Re: Velocizzare macro per scorrere le righe

Postdi Anthony47 » 28/02/20 16:09

L' elenco di cose da evitare quando si lavora su algoritmi molto impegnativi e' lungo; i top 5:
-non selezionare fogli o celle; puoi infatti quasi sempre indirizzare in modo esplicito il foglio e l'intervallo su cui applicare un metodo o una proprieta'
-evitare istruzioni inutili, per ovvi motivi:
-non ripetere calcoli che possono essere fatti una sola volta
-limitare la lettura /scrittura di dati sul foglio di lavoro
-usare algoritmi che riducono le elaborazioni

Con queste attenzioni piu' qualche altro trucco, ho abbozzato:
Codice: Seleziona tutto
Sub Ruote_In_zColonna_Cad_Anth()
Dim myTim As Single, LastA As Long, LastC As Long, II As Long, JJ As Long, KK As Long
Dim WArr, OCArr(), beTab As String, cRuota As String, lFor As Long, iOut As Long, sFor As String

Sheets("Uso").Select

myTim = Timer
LastA = Cells(Rows.Count, 1).End(xlUp).Row
LastC = Cells(6, Columns.Count).End(xlToLeft).Column

Application.ScreenUpdating = False

beTab = "A5"        '<<< Inizio Tabella dati
lFor = 2            '<<< 2, 3, ..
sFor = " ambo "     '<<< ?? ambo, terno, ??

WArr = Range(beTab).Resize(LastA - Range(beTab).Row + 1, LastC - Range(beTab).Column + 1).Value
ReDim OCArr(1 To 1)
Sheets("Tabella").Range("A2").Resize(1000, 1000).ClearContents

For II = 3 To UBound(WArr)
If Len(WArr(II, 1)) > 5 Then
    DoEvents
    iOut = 0
    For JJ = 1 To 11
        cRuota = WArr(2, JJ + 1)
        For KK = JJ + 1 To UBound(WArr, 2) Step 11
            If WArr(II, KK) = lFor Then
                iOut = iOut + 1
                ReDim Preserve OCArr(1 To iOut)
                OCArr(iOut) = WArr(II, 1) & " - " & WArr(1, KK) & sFor & cRuota
            End If
        Next KK
'        Debug.Print cRuota, Cells(1, JJ).Address
    Next JJ
    jjc = jjc + 1
'    Debug.Print jjc, cRuota, Cells(1, JJ).Address
    Sheets("Tabella").Cells(2, jjc).Resize(iOut, 1).Value = Application.WorksheetFunction.Transpose(OCArr)
Else
    jjc = jjc + 1
End If
Next II
'Debug.Print Format(Timer - myTim, "0.00")
'Stop
Application.ScreenUpdating = True
MsgBox ("Completato in: " & Format(Timer - myTim, "0.00"))
End Sub

Prova e fai sapere...
Avatar utente
Anthony47
Moderatore
 
Post: 16956
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Velocizzare macro per scorrere le righe

Postdi ikwae » 28/02/20 19:45

Ciao
ho provato la macro è velocizzima anzi istantanea ma quando inserisco il numero 3 o 4 in lFor esce l'errore evidenziado la linea marcata. Se hai tempo, con calma e la puoi mettere a posto ti ringrazio anticipatamente. Inutile dirti che ho cercato nel codice quanche cosa che mi dia qualche inidcazione per togliere l'errore e mi sono accorto che usi massiccie dosi di matrici(almeno questo è quello che ho capito al mio livello) e di conseguenza senza combinare ulteriori guai ho preferito scriverti. Ma la studierò attentamente rigo per rigo. Ringraziandoti per il tempo che mi stai dedicando cordialmente ikwae.

lFor = 2 '<<< 2, 3, ..
Sheets("Tabella").Cells(2, jjc).Resize(iOut, 1).Value = Application.WorksheetFunction.Transpose(OCArr) <<<<<<<<<<<<
Excel 2007
Avatar utente
ikwae
Utente Senior
 
Post: 154
Iscritto il: 27/12/17 23:14

Re: Velocizzare macro per scorrere le righe

Postdi Anthony47 » 28/02/20 23:52

Eh, dovevo aspettarmelo quell'errore...

Il modo piu' pulito per eliminarlo e' sostituire quella riga con quest'altra:
Codice: Seleziona tutto
    If iOut > 0 Then Sheets("Tabella").Cells(2, jjc).Resize(iOut, 1).Value = Application.WorksheetFunction.Transpose(OCArr)


mi sono accorto che usi massiccie dosi di matrici
La matrice WArr viene popolata col "tabellone" di foglio Uso per limitare la lettura ripetuta cella per cella; la matrice OCArr serve per creare il contenuto delle singole colonne.

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

Re: Velocizzare macro per scorrere le righe

Postdi ikwae » 29/02/20 01:35

Ciao ... adesso è tutto a posto è veloce e preciso eventualmente chiederò aiuto...
Anthony47 ha scritto:
mi sono accorto che usi massicce dosi di matrici
La matrice WArr viene popolata col "tabellone" di foglio Uso per limitare la lettura ripetuta cella per cella; la matrice OCArr serve per creare il contenuto delle singole colonne.
Ciao

Pensavo che erano almeno 4 le tue massicce matrici ... una per il tabellone una per le righe una per memorizzare le 11 ruote e una per "incanalare" la scritta nelle colonne una a riga.
Comunque è fonte di studio anche se è molta complessa. Comincerò con i top 5 che sembrano più consoni per il mio livello.
Ringraziandoti tanto per il tuo tempo che mi hai dedicato e per la tua pazienza... due spaghetti no! ... comunque grazie ancora cordialmente ikwae
Excel 2007
Avatar utente
ikwae
Utente Senior
 
Post: 154
Iscritto il: 27/12/17 23:14


Torna a Applicazioni Office Windows


Topic correlati a "Velocizzare macro per scorrere le righe":


Chi c’è in linea

Visitano il forum: Nessuno e 14 ospiti