ho recuperato qua e la qualche linea di codice, che a "naso" 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