Condividi:        

CORTESEMENTE - UNA MACRO

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

Re: CORTESEMENTE - UNA MACRO

Postdi Lucio Peruggini » 15/10/13 01:19

https://dl.dropboxusercontent.com/u/182 ... na%20J.PNG
https://dl.dropboxusercontent.com/u/182 ... na%20J.PNG

Ho sostituito le due immagini all'estrazione 8752 perché errato quanto scritto nelle colonne "Q:S"

Ciao
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Sponsor
 

Re: CORTESEMENTE - UNA MACRO

Postdi Flash30005 » 15/10/13 10:26

Sistemiamo prima questa macro, controlla che ora sia a posto almeno per le colonne I:P
Codice: Seleziona tutto
Sub TrovaAgg()
Set Ws1 = Worksheets("Archivio")
Set Ws2 = Worksheets("Attuali")
'Ws2.Range("K8:K1000").ClearContents
For CCA = 3 To 48 Step 5
Dim VNA(90) As Integer
RuA = UCase(Trim(Ws1.Cells(1, CCA)))
For NV = 1 To 90
For Onu = 1 To 5
If NV = Ws1.Cells(2, CCA + Onu - 1).Value Then VNA(Onu) = Ws1.Cells(2, CCA + Onu - 1).Value
Next Onu
Next NV
UR1 = Ws2.Range("B" & Rows.Count).End(xlUp).Row
For RR1 = 8 To UR1
Ambo = ""
If UCase(Trim(Ws2.Range("B" & RR1).Value)) = UCase(Trim(RuA)) Then
For NV = 1 To 5
For NP = 1 To 5
If VNA(NV) = Ws2.Cells(RR1, 3 + NP).Value Then
Ambo = Ambo & " - " & VNA(NV)
End If
Next NP
Next NV
End If
If Ws2.Cells(RR1, 12).Value < Ws1.Range("A2").Value Then
    DiffRit = Ws1.Range("A2").Value - Ws2.Cells(RR1, 9).Value
    RuA2 = UCase(Trim(Ws2.Range("B" & RR1).Value))
    If RuA = RuA2 Then
        If Len(Ambo) > 5 Then
            If Ws2.Cells(RR1, 11).Value = "" Then
                Ws2.Cells(RR1, 12).Value = Ws1.Range("A2").Value
                Ws2.Cells(RR1, 13).Value = CDate(Ws1.Range("B2").Value)
                Ws2.Cells(RR1, 10).Value = DiffRit
                Ws2.Cells(RR1, 14).Value = "Sto"
                Ws2.Cells(RR1, 11).Value = Trim(Mid(Ambo, 3, Len(Ambo)))
                Ws2.Cells(RR1, 16).Value = "Positivo"
                Ws2.Cells(RR1, 15).Value = "Ambo"
                If Len(Ws2.Cells(RR1, 11).Value) > 8 Then Ws2.Cells(RR1, 15).Value = "Terno"
                If Len(Ws2.Cells(RR1, 11).Value) > 13 Then Ws2.Cells(RR1, 15).Value = "Quaterna"
            End If
        Else
            Ws2.Cells(RR1, 10).Value = DiffRit
            Ws2.Cells(RR1, 12).Value = Ws1.Range("A2").Value
            Ws2.Cells(RR1, 13).Value = CDate(Ws1.Range("B2").Value)
        End If
    End If
End If
Next RR1
Next CCA
End Sub


Per le spie ancora ho dei dubbi
come, ad esempio, del perché non hai menzionato anche il 77 su Venezia tra le spie da aggiungere.

ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: CORTESEMENTE - UNA MACRO

Postdi Lucio Peruggini » 15/10/13 11:32

Ciao Flash, il 77 su Venezia mi era proprio sfuggito! Certo che è da inserire.
Provo la macro e ti faccio sapere.
Ciao
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: CORTESEMENTE - UNA MACRO

Postdi Lucio Peruggini » 15/10/13 13:40

Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: CORTESEMENTE - UNA MACRO

Postdi Flash30005 » 15/10/13 15:58

Copia l'intero codice (sono due macro collegate)
Codice: Seleziona tutto
Sub TrovaAgg()
Set Ws1 = Worksheets("Archivio")
Set Ws2 = Worksheets("Attuali")
AggS = 0
'Ws2.Range("K8:K1000").ClearContents
For CCA = 3 To 48 Step 5
Dim VNA(90) As Integer
RuA = UCase(Trim(Ws1.Cells(1, CCA)))
For NV = 1 To 90
For Onu = 1 To 5
If NV = Ws1.Cells(2, CCA + Onu - 1).Value Then VNA(Onu) = Ws1.Cells(2, CCA + Onu - 1).Value
Next Onu
Next NV
UR1 = Ws2.Range("B" & Rows.Count).End(xlUp).Row
For RR1 = 8 To UR1
Ambo = ""
If UCase(Trim(Ws2.Range("B" & RR1).Value)) = UCase(Trim(RuA)) Then
For NV = 1 To 5
For NP = 1 To 5
If VNA(NV) = Ws2.Cells(RR1, 3 + NP).Value Then
Ambo = Ambo & " - " & VNA(NV)
End If
Next NP
Next NV
End If
If Ws2.Cells(RR1, 12).Value < Ws1.Range("A2").Value Then
AggS = 1
    DiffRit = Ws1.Range("A2").Value - Ws2.Cells(RR1, 9).Value
    RuA2 = UCase(Trim(Ws2.Range("B" & RR1).Value))
    If RuA = RuA2 Then
        If Len(Ambo) > 5 Then
            If Ws2.Cells(RR1, 11).Value = "" Then
                Ws2.Cells(RR1, 12).Value = Ws1.Range("A2").Value
                Ws2.Cells(RR1, 13).Value = CDate(Ws1.Range("B2").Value)
                Ws2.Cells(RR1, 10).Value = DiffRit
                Ws2.Cells(RR1, 14).Value = "Sto"
                Ws2.Cells(RR1, 11).Value = Trim(Mid(Ambo, 3, Len(Ambo)))
                Ws2.Cells(RR1, 16).Value = "Positivo"
                Ws2.Cells(RR1, 15).Value = "Ambo"
                If Len(Ws2.Cells(RR1, 11).Value) > 8 Then Ws2.Cells(RR1, 15).Value = "Terno"
                If Len(Ws2.Cells(RR1, 11).Value) > 13 Then Ws2.Cells(RR1, 15).Value = "Quaterna"
            End If
        Else
            If Ws2.Cells(RR1, 11).Value = "" Then
                Ws2.Cells(RR1, 10).Value = DiffRit
                Ws2.Cells(RR1, 12).Value = Ws1.Range("A2").Value
                Ws2.Cells(RR1, 13).Value = CDate(Ws1.Range("B2").Value)
            End If
        End If
    End If
End If
Next RR1
Next CCA
If AggS = 1 Then TrovaSpia
End Sub
Sub TrovaSpia()
Set Ws1 = Worksheets("Archivio")
Set Ws2 = Worksheets("Attuali")
For CCA = 48 To 3 Step -5
Dim VNA(90) As Integer
RuA = UCase(Trim(Ws1.Cells(1, CCA)))
For NV = 1 To 90
For Onu = 1 To 5
If NV = Ws1.Cells(2, CCA + Onu - 1).Value Then VNA(Onu) = Ws1.Cells(2, CCA + Onu - 1).Value
Next Onu
Next NV
NewR = Ws2.Range("B" & Rows.Count).End(xlUp).Row
For NV = 5 To 1 Step -1
    For RR1 = NewR To 8 Step -1
        If UCase(Trim(Ws2.Range("B" & RR1).Value)) = UCase(Trim(RuA)) Then
            If VNA(NV) = Ws2.Cells(RR1, 3).Value Then
                Rows(RR1 + 1 & ":" & RR1 + 1).Insert Shift:=xlDown
                Ws2.Range("A" & RR1 & ":P" & RR1).Copy Destination:=Ws2.Range("A" & RR1 + 1)
                Application.CutCopyMode = False
                Ws2.Range("I" & RR1 + 1).Value = Ws1.Range("A2").Value
                Ws2.Cells(RR1 + 1, 13).Value = CDate(Ws1.Range("B2").Value)
                Ws2.Range("J" & RR1 + 1).Value = 0
                NewR = RR1
                GoTo SaltaNV
            End If
        End If
    Next RR1
SaltaNV:
Next NV
Next CCA
UR1 = Ws2.Range("B" & Rows.Count).End(xlUp).Row
For RR1 = 8 To UR1
Range("A" & RR1).Value = RR1 - 7
Next RR1

End Sub

Avvia solo la prima "TrovaAgg".
La macro non si avvierà se il numero del concorso elaborato è uguale o maggiore di quello che si andrà a processare
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: CORTESEMENTE - UNA MACRO

Postdi Lucio Peruggini » 15/10/13 21:11

Ciao Flash
Inizio a vedere una passeggiata nei boschi, per ora solo virtuale.

Il numero spia 77 su Cagliari estrazione 8752 riga 44, non viene aggiunto.
https://dl.dropboxusercontent.com/u/182 ... a%2044.PNG

E’ molto strano perché alla 8751 tutto era in ordine, quattro numeri aggiunti (Na-45 e 55; To.81; Ve-77).
Alla 8752 ci sono 13 spie da aggiungere; tutto è filato liscio come l’olio tranne per l’appunto il 77 su Cagliari, riga non incrementata.
I numeri spia a questa estrazione sono:
BA 34
CA 15 E 77…………….15 Ok; 77 No.
FI 10 E 90
GE 6-73-87
MI 43
PA 38 E 63
RO 11
TO 48

Forse è inutile dirlo: a priori sapevo benissimo che la macro sarebbe andata in porto.
In questo forum siete maestri!
GRAZIEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE!!!

Peraltro avevo dimenticato di eliminare da questo foglio alcune righe di eventi che, in realtà sono doppioni; difetto del listato adoperato (da correggere).

Rimane dunque solamente questo 77 su Cagliari da inquadrare che potrebbe ripetersi anche successivamente e con altri numeri.

Ciao
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: CORTESEMENTE - UNA MACRO

Postdi Lucio Peruggini » 15/10/13 22:01

Sono andato avanti con le estrazioni ed è sorto un altro piccolo inconveniente.
La spia 75 di Bari si ripete alla 8754 ma questa, aveva già chiuso il gioco alla 8752 con l'ambo 66.5; non doveva più essere incrementata.

https://dl.dropboxusercontent.com/u/182 ... a%2027.PNG

Ciao

Ricorderai che nei post precedenti era specificato che la macro interviene solamente sui casi "Att". Questi, però, sono inconvenienti non prevedibili a priori.
Ultima modifica di Lucio Peruggini su 15/10/13 22:07, modificato 1 volte in totale.
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: CORTESEMENTE - UNA MACRO

Postdi Flash30005 » 15/10/13 22:06

Fai attenzione perché non posso credere che per 5 numeri per ruota e per 9 ruote tutto funzioni e su una ruota no.
Quindi presumo che ci siano campi sporchi.
per evitare questo ho messo il codice che elimina spazi vuoti e maiuscole/minuscole ma molto probabilmente si tratta di altro.
Quindi prova a ridigitare sia la ruota (controlla che occupi la cella giusta conforme alle altre)
e digita di nuovo anche i 5 numeri.
Se non riesci dovresti inviarmi il file aggiornato all'estrazione precedente (8751) e con i dati dell'estrazione 8752 in archivio
per poter verificare quanto detto

ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: CORTESEMENTE - UNA MACRO

Postdi Flash30005 » 15/10/13 22:08

Anche questo secondo inconveniente è alquanto strano perché se la cella è già scritta con un ambo non può più aggiornarla.
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: CORTESEMENTE - UNA MACRO

Postdi Lucio Peruggini » 15/10/13 22:23

Può benissimo essere come dici ma non ho fatto altro che incollare dall'originale il foglio "Attuali".
Comunque invio questo foglio con le correzioni apportate alla macro con inserimento anche della seconda, per le spie.
Intanto ti avevo scritto per un altro inconveniente; ci siamo accavallati con i post.

https://dl.dropboxusercontent.com/u/182 ... li%20.xlsm

Rispondo anche a questo secondo inconveniente:

Probabilmente in questo caso è la seconda macro che non rispetta i casi chiusi della prima.
Non so che dire: invio il foglio e, inserendo le estrazioni una per volta dopo aver incollato dall'originale la 8750, vedi cosa succede.
Ciao
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: CORTESEMENTE - UNA MACRO

Postdi Lucio Peruggini » 15/10/13 23:02

Ho fatto una semplice prova riguardo il secondo inconveniente.

Ho incollato di nuovo le colonne "A:P" dell'originale e lanciato la macro con dentro l'estrazione 8751. Orbene, esce l'ambo di Firenze 56.8 proveniente dalla spia 19; fin qui è ok ( ho visto solamente questa stringa).

Ho poi fittiziamente inserito il numero spia 19 nell'estrazione successiva, la 8752. Anche in questo caso, la spia viene incrementata con nuova riga non tenendo conto che si trattava di caso "Sto", quindi chiuso.
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: CORTESEMENTE - UNA MACRO

Postdi Flash30005 » 16/10/13 00:48

Allora la ripetizione della spia era un bug che ho corretto con questa macro (solo macro "trovaSpia", l'altra rimane invariata)
Codice: Seleziona tutto
Sub TrovaSpia()
Set Ws1 = Worksheets("Archivio")
Set Ws2 = Worksheets("Attuali")
For CCA = 48 To 3 Step -5
Dim VNA(90) As Integer
RuA = UCase(Trim(Ws1.Cells(1, CCA)))
For NV = 1 To 90
For Onu = 1 To 5
If NV = Ws1.Cells(2, CCA + Onu - 1).Value Then VNA(Onu) = Ws1.Cells(2, CCA + Onu - 1).Value
Next Onu
Next NV
NewR = Ws2.Range("B" & Rows.Count).End(xlUp).Row
For NV = 5 To 1 Step -1
    For RR1 = NewR To 8 Step -1
        If UCase(Trim(Ws2.Range("B" & RR1).Value)) = UCase(Trim(RuA)) Then
        MsgBox VNA(NV) - Ws2.Cells(RR1, 3).Value & "'" & Trim(Ws2.Range("N" & RR1).Value) & "'"
            If VNA(NV) = Ws2.Cells(RR1, 3).Value And Trim(Ws2.Range("N" & RR1).Value) <> "Sto" Then
                Rows(RR1 + 1 & ":" & RR1 + 1).Insert Shift:=xlDown
                Ws2.Range("A" & RR1 & ":P" & RR1).Copy Destination:=Ws2.Range("A" & RR1 + 1)
                Application.CutCopyMode = False
                Ws2.Range("I" & RR1 + 1).Value = Ws1.Range("A2").Value
                Ws2.Cells(RR1 + 1, 13).Value = CDate(Ws1.Range("B2").Value)
                Ws2.Range("J" & RR1 + 1).Value = 0
                NewR = RR1
                GoTo SaltaNV
            End If
        End If
    Next RR1
SaltaNV:
Next NV
Next CCA
UR1 = Ws2.Range("B" & Rows.Count).End(xlUp).Row
For RR1 = 8 To UR1
Range("A" & RR1).Value = RR1 - 7
Next RR1

End Sub


Mentre la spia 77 su Cagliari estrazione 8754 non deve essere inserita perché il 77 in quella estrazione non è uscito.

ciao

EDIT ore 02:10 - corretta macro perché ho notato che i tuoi dati non sono "sporchi" ma di più... la colonna "N" con "Att" è un campo "sporco" con spazi non riconosciuti.
vedi se la macro qui riproposta funziona, ora.
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: CORTESEMENTE - UNA MACRO

Postdi Lucio Peruggini » 16/10/13 01:22

Mentre ila spia 77 su Cagliari estrazione 8754 non deve essere inserita perché il 77 in quella estrazione non è uscito.


Ciao Flash, hai preso una svista; l'estrazione cui facevo riferimento è la 8752 non la 8754.

All'estrazione 8750 abbiamo su Cagliari la spia 77; questa si è ripetuta alla 8752 ma non è stata aggiunta.

Comunque riprovo ancora partendo dalla 8751 e inserisco le correzioni sulla macro-spia. Domani, anzi oggi (sto leggendo questo tuo messaggio e sono le ore 2.20) ti farò sapere.
Intanto, ancora grazie - Notte
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: CORTESEMENTE - UNA MACRO

Postdi Lucio Peruggini » 16/10/13 01:39

La curiosità era troppa.
Ho inserito la correzione e lanciato la macro alla 8751. Inizia aprocessare ma subito, mi dà l'errore che vedi nella foto e la rotellina gira ininterrottamente.

https://dl.dropboxusercontent.com/u/182 ... ultima.PNG
Ciao
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: CORTESEMENTE - UNA MACRO

Postdi Flash30005 » 16/10/13 11:25

Non è un errore è un messaggio che ti mostra come il campo Att sia sporco se fosse pulito avresti avuto -12'Att' e non -12' Att '
Commenta o togli questa riga codice
Codice: Seleziona tutto
MsgBox VNA(NV) - Ws2.Cells(RR1, 3).Value & "'" & Trim(Ws2.Range("N" & RR1).Value) & "'"

che trovi all'inizio del ciclo
For RR1 = NewR to 8 Step-1


ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: CORTESEMENTE - UNA MACRO

Postdi Lucio Peruggini » 16/10/13 14:48

Allora cosa mi consigli per pulire il foglio? Elimino questo foglio e ne faccio uno nuovo?
Penso che farò così anche per provare perché rimane appeso ancora il 77 di Cagliari alla 8752 che non è stato aggiunto.
Fammi sapere, grazie.
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: CORTESEMENTE - UNA MACRO

Postdi Flash30005 » 16/10/13 15:13

Con l'ultima macro non dovresti avere più problemi
se rilevi che ce ne siano mi dovresti inviare il file con aggiornamento all'ultima estrazione corretta e in archivio l'estrazione che lo causa.
Avrò, così, la possibilità di verificare facendo io stesso l'aggiornamento

cio
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: CORTESEMENTE - UNA MACRO

Postdi Lucio Peruggini » 16/10/13 16:17

Ciao Flash, ho rifatto completamente un foglio nuovo e, giusto per provare, inserisco in Archivio a partire dalla 8751 due numeri spia per ruota senza far uscire eventi positivi. Avremo dunque già in questa estrazione due righe per ogni ruota da aggiungere = 20 righe.

Ho anche eliminato dal foglio "Originale degli attuali" i cinque doppioni anche se questi non influivano affatto per l'esecuzione che la macro svolge.

Faccio un po di prove e vedo cosa succede.
Ciao
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: CORTESEMENTE - UNA MACRO

Postdi Lucio Peruggini » 16/10/13 20:30

Ciao Flash, ho inserito in archivio due numeri per ruote. Si tratta dei primi due per ruota che trovi nella colonna “C” foglio “Attuali”; facilmente visibili adoperando il filtro della colonna “J”. I ritardi che si sono azzerati, sono i nuovi immessi.
Anche se sono usciti tre ambi in altre cinquine non hanno importanza per quanto riguarda l’aggiunta dei numeri spia ripetuti.
In questo caso, su venti numeri spia immessi, diciotto sono stati aggiunti e due di essi no.
Sono le ruote di Torino e Venezia laddove si ha una sola aggiunta, il nove che è presente sia su Torino sia Venezia; mancano le aggiunte del 17 su TO e 10 su VE.

Ho fatto tutto nuovo e non capisco proprio, dove possa annidarsi l’inghippo.
https://dl.dropboxusercontent.com/u/182 ... nuovo.xlsm

Ciao
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: CORTESEMENTE - UNA MACRO

Postdi Lucio Peruggini » 16/10/13 23:39

Ciao Flash, pensavo:
Se proprio non si riesce a risolvere l'enigma, si potrebbe ovviare con una formattazione condizionale che colori (unico colore) le spie ripetute in colonna "C". In questo modo, se proprio ne salta qualcuna, riesco subito a rintracciarla e la inserisco manualmente.

Solamente che le celle colorate a ogni estrazione incrementata, devono essere resettate per l'immissione dei nuovi numeri spia .

Oggi è stata una giornataccia; con l'influenza ho una testa pesante come un mattone.
Vado a nanna, ciao
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

PrecedenteProssimo

Torna a Applicazioni Office Windows


Topic correlati a "CORTESEMENTE - UNA MACRO":


Chi c’è in linea

Visitano il forum: Nessuno e 50 ospiti