PICCOLA AGGIUNTA SU MACRO

[Lucio Peruggini]

Ciao Flash, chiedo scusa:
Questa va aggiunta sotto la prima macro oppure in altro modulo?
Oppure sostituisce la prima macro?
Ciao

[Flash30005]

sostituisce la macro avente lo stesso nome

[Lucio Peruggini]

L'ho fatto proprio in questo momento ma, non aggiunge agli eventi sfaldati, la riga successiva che rimette in gioco la medesima cinquina.

[Lucio Peruggini]

Ciao Flash, innanzitutto grazie per quanto stai facendo e per l’aiuto che stai apportando a questa mia ricerca che da otto mesi sto portando avanti e non ho ancora mollato.
A dire il vero: da un mesetto sto esaminando cosa succede con questa ricerca che mi sta intrigando non poco.

Ti allego questo foglio che prende in considerazione esclusivamente una ruota (Venezia), con novanta spie e quindi novanta cinquine aggregate. In archivio ci sono quaranta estrazioni e, partendo dalla prima (l’8747), si può verificare la macro che hai modificato.

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

Orbene, alla prima estrazione successiva (8748) si ha quanto segue:

Spie ripetute e aggiunte, quindi a ritardo a ritardo “0” = 5; righe 61-64-71-80-82.
Fin qui tutto ok come prima.

Eventi sfaldati alla 8778 = 12. Righe <11-22-37-66-74-75-95-96-101-105-106-111> di cui: otto ambi e quattro terni.
Noterai che a questi eventi sfaldati, manca la riga (stringa) successiva che deve rimettere in gioco la stessa cinquina appena sfaldata; che è poi quanto ho chiesto con questa modifica.

Se questo non avviene, le cinquine appena sfaldate, non saranno più prese in considerazione e quindi nell’estrazione successiva ci ritroveremmo con 12 cinquine in meno.

Note:
Volendo ripartire d’all’inizio basta copiare dal foglio “Att. Originale alla 8747” e inserire nel foglio “Attuali”. Lanciare la macro appena corretta e avrai gli esiti su indicati.
Ciao e buona giornata.

[Flash30005]

Quindi mi stai dicendo che non è cambiato nulla rispetto a prima?

Se così allora ripristino la riga codice precedente e modifico la macro in questa maniera

Codice: Seleziona tutto

Sub TrovaSpia() '............................................................................................
Set Ws1 = Worksheets("Archivio")
Set Ws2 = Worksheets("Attuali")
For CCA = 48 To 3 Step -5
Dim VNA(5) As Integer
Dim VNC(90) As Integer
RuA = UCase(Trim(Ws1.Cells(1, CCA)))
VNC(1) = Ws1.Cells(2, CCA).Value
VNC(2) = Ws1.Cells(2, CCA + 1).Value
VNC(3) = Ws1.Cells(2, CCA + 2).Value
VNC(4) = Ws1.Cells(2, CCA + 3).Value
VNC(5) = Ws1.Cells(2, CCA + 4).Value
CCV = 0
For NV = 1 To 90
For Onu = 1 To 5
If NV = Ws1.Cells(2, CCA + Onu - 1).Value Then
CCV = CCV + 1
VNA(CCV) = Ws1.Cells(2, CCA + Onu - 1).Value
End If
Next Onu
Next NV
NewR = Ws2.Range("B" & Rows.Count).End(xlUp).Row
For NVR = 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 Trim(Ws2.Range("N" & RR1).Value) = "Sto" And Ws2.Range("J" & RR1 + 1).Value <> 0 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("J" & RR1 + 1).Value = 0
                Ws2.Range("K" & RR1 + 1).ClearContents
                Ws2.Range("N" & RR1).Value = "Att"
                Ws2.Range("O" & RR1 + 1).ClearContents
                Ws2.Range("P" & RR1).Value = "in corso"
                End If
            If VNA(NVR) = 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 NVR
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


Prova e fai sapere

ciao

[Lucio Peruggini]

Ciao Flash, ci siamo quasi:

https://dl.dropboxusercontent.com/u/182 ... ncanti.png

Su nove cinquine sfaldate sei sono corrette (riga aggiunta); contrassegnate dalla linea nera senza la freccetta in testa.
Le prime tre invece, non ha aggiunto nessuna riga (contrassegnate con freccetta).

Ho rimesso gli attuali di partenza (indice 8747); ho inserito la successiva (8748) e gli esiti sono quelli colorati in giallo.
Sei giusti, tre mancanti!
Ciao

[Lucio Peruggini]

Vi è anche un altro inconveniente: sulle sei giuste la riga aggiunta, deve riportare "Att" col. "N"; nulla nella colonna successiva "O" e "in corso" nella colonna "P" che va bene.

[Flash30005]

Prova questa

Codice: Seleziona tutto

Sub TrovaSpia() '............................................................................................
Set Ws1 = Worksheets("Archivio")
Set Ws2 = Worksheets("Attuali")
For CCA = 48 To 3 Step -5
Dim VNA(5) As Integer
Dim VNC(90) As Integer
RuA = UCase(Trim(Ws1.Cells(1, CCA)))
VNC(1) = Ws1.Cells(2, CCA).Value
VNC(2) = Ws1.Cells(2, CCA + 1).Value
VNC(3) = Ws1.Cells(2, CCA + 2).Value
VNC(4) = Ws1.Cells(2, CCA + 3).Value
VNC(5) = Ws1.Cells(2, CCA + 4).Value
CCV = 0
For NV = 1 To 90
For Onu = 1 To 5
If NV = Ws1.Cells(2, CCA + Onu - 1).Value Then
CCV = CCV + 1
VNA(CCV) = Ws1.Cells(2, CCA + Onu - 1).Value
End If
Next Onu
Next NV
NewR = Ws2.Range("B" & Rows.Count).End(xlUp).Row
For NVR = 5 To 1 Step -1
    For RR1 = NewR To 8 Step -1
        If Trim(Ws2.Range("N" & RR1).Value) = "Sto" And Ws2.Range("J" & RR1 + 1).Value <> 0 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("J" & RR1 + 1).Value = 0
            Ws2.Range("K" & RR1 + 1).ClearContents
            Ws2.Range("N" & RR1 + 1).Value = "Att"
            Ws2.Range("O" & RR1 + 1).ClearContents
            Ws2.Range("P" & RR1 + 1).Value = "in corso"
        End If
        If UCase(Trim(Ws2.Range("B" & RR1).Value)) = UCase(Trim(RuA)) Then
            If VNA(NVR) = 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 NVR
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


Ciao

[Lucio Peruggini]

Gloria a Dio!

Mi pareva strano che tu non riuscissi anche in questa impresa “per la verità non facile”.

https://dl.dropboxusercontent.com/u/182 ... ovaAgg.PNG

Vi è però un piccolo aggiusto anche nell’altra macro “TrovaAgg” che ora, sfasa i gruppi.
Come puoi vedere da Immagine, le colonne che riguardano gli eventi sfaldati, riportano in R:U i valori di un gruppo 2; che ora è divenuto UNIVOCO.
In questo caso dovremmo avere solamente in “R=1” come gli altri univoci; in “S=0”.
La cinquina, infatti, riparte da zero.

Ancora un pochino del tuo tempo e hai perfezionato magnificamente questo lavoro.

INFINITAMENTE GRAZIE!!!!!!!!!!!!!!!!!
Ciao

[Lucio Peruggini]

Forse ho esultato troppo in fretta!

Colonne “J-M-N” non si aggiornano i valori.
All’estrazione successiva i valori citati sono rimasti alla 8748; così anche per gli altri “0” della colonna “J” che hanno incrementato di una riga la spia ripetuta.

https://dl.dropboxusercontent.com/u/182 ... 20ZERI.PNG

Ciao

Mi edito
gli zero che aggiornano la spia, vanno bene!
Sono solo quelli dopo gli storici che restano all'estrazione precedente.

[Flash30005]

La macro TrovaAgg non è stata modificata pertanto lo "sfasamento" non dipende da essa
Non so se questa versione possa andare bene perché mi sembra di aver trovato gli stessi dati in un file precedente a tutte le modifiche, comunque prova

Codice: Seleziona tutto

Sub TrovaSpia() '............................................................................................
Set Ws1 = Worksheets("Archivio")
Set Ws2 = Worksheets("Attuali")
For CCA = 48 To 3 Step -5
Dim VNA(5) As Integer
Dim VNC(90) As Integer
RuA = UCase(Trim(Ws1.Cells(1, CCA)))
VNC(1) = Ws1.Cells(2, CCA).Value
VNC(2) = Ws1.Cells(2, CCA + 1).Value
VNC(3) = Ws1.Cells(2, CCA + 2).Value
VNC(4) = Ws1.Cells(2, CCA + 3).Value
VNC(5) = Ws1.Cells(2, CCA + 4).Value
CCV = 0
For NV = 1 To 90
For Onu = 1 To 5
If NV = Ws1.Cells(2, CCA + Onu - 1).Value Then
CCV = CCV + 1
VNA(CCV) = Ws1.Cells(2, CCA + Onu - 1).Value
End If
Next Onu
Next NV
NewR = Ws2.Range("B" & Rows.Count).End(xlUp).Row
For NVR = 5 To 1 Step -1
    For RR1 = NewR To 8 Step -1
        If Trim(Ws2.Range("N" & RR1).Value) = "Sto" And Ws2.Range("J" & RR1 + 1).Value <> 0 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("J" & RR1 + 1).Value = 0
            Ws2.Range("K" & RR1 + 1).ClearContents
            Ws2.Range("N" & RR1 + 1).Value = "Att"
            Ws2.Range("O" & RR1 + 1).ClearContents
            Ws2.Range("P" & RR1 + 1).Value = "in corso"
            Ws2.Range("R" & RR1 + 1).Value = 1
            Ws2.Range("S" & RR1 + 1).Value = 0
        End If
        If UCase(Trim(Ws2.Range("B" & RR1).Value)) = UCase(Trim(RuA)) Then
            If VNA(NVR) = 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 NVR
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


Ciao

[Flash30005]

Colonne “J-M-N” non si aggiornano i valori

Ma in J non deve esserci 0 (zero)? Perché dici che non si aggiorna?

[Lucio Peruggini]

Non si aggiorna all'estrazione successiva.
Infatti dall'immagine allegata noterai che ho lanciato la macro con dentro la 8749 e quindi i valori della 8748 (che erano a ritardo zero), dovevano portarsi a ritardo uno; compreso l'indice e la data che sono rimasti alla 8748.

Tutto questo indipendentemente dall'altra macro che aggiorna i gruppi che, come spiegato, andrebbe apportata una modifica che li aggiorni correttamente.
Ciao

[Flash30005]

Si, penso di aver capito dove è il bug
la modifica non andava fatta sulla macro TrovaSpia ma su TrovaAgg pertanto sostituisci entrambe le macro con questo codice

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 And Trim(Trim(Ws2.Cells(RR1, 14).Value)) <> "Sto" Then  '<<< ULTIMA STRINGA INSERITA

'If Ws2.Cells(RR1, 12).Value < Ws1.Range("A2").Value And Trim(Ws2.Cells(RR1, 12).Value) = "Att" Then   '<<< SOSTITUITA STRINGA - 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(Ws2.Cells(RR1, 11).Value) < 5 Then
            If Len(Ambo) > 5 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"
           
                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("J" & RR1 + 1).Value = 0
                Ws2.Range("K" & RR1 + 1).ClearContents
                Ws2.Range("L" & RR1 + 1).Value = Ws1.Range("A2").Value
                Ws2.Range("M" & RR1 + 1).Value = CDate(Ws1.Range("B2").Value)
                Ws2.Range("N" & RR1 + 1).Value = "Att"
                Ws2.Range("O" & RR1 + 1).ClearContents
                Ws2.Range("P" & RR1 + 1).Value = "in corso"
                Ws2.Range("R" & RR1 + 1).Value = 1
                Ws2.Range("S" & RR1 + 1).Value = 0
               
             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
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(5) As Integer
Dim VNC(90) As Integer
RuA = UCase(Trim(Ws1.Cells(1, CCA)))
VNC(1) = Ws1.Cells(2, CCA).Value
VNC(2) = Ws1.Cells(2, CCA + 1).Value
VNC(3) = Ws1.Cells(2, CCA + 2).Value
VNC(4) = Ws1.Cells(2, CCA + 3).Value
VNC(5) = Ws1.Cells(2, CCA + 4).Value
CCV = 0
For NV = 1 To 90
For Onu = 1 To 5
If NV = Ws1.Cells(2, CCA + Onu - 1).Value Then
CCV = CCV + 1
VNA(CCV) = Ws1.Cells(2, CCA + Onu - 1).Value
End If
Next Onu
Next NV
NewR = Ws2.Range("B" & Rows.Count).End(xlUp).Row
For NVR = 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(NVR) = 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 NVR
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



Fai sapere se ci sono (e sicuramente ci saranno) altre modifiche da fare

ciao

[Lucio Peruggini]

Ciao Flash, commento la prima estrazione successiva, l’8747.

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

Orbene, la riga 11 e la 23 sono ok! Vi è però l’inghippo nelle righe successive che, nella colonna “I” devono riportare il medesimo valore di “L”. Cioè, le cinquine rimesse in gioco che ripartono con ritardo “0” dall’estrazione 8748. Se non si aggiusta questa colonna, all’estrazione successiva avvengono errori.
Inoltre, la macro non aggiorna le ultime sette righe della colonna “L” all’estrazione corrente; queste sono rimaste alla 8747.
Non aggiorna nemmeno le spie ripetute della colonna “C” che formano i gruppi. Infatti, nella colonna “R” abbiamo solamente spie univoche; mancano esattamente cinque gruppi di “spia ripetuta” che ho colorato di giallo in “C”.
Perciò, se non s’inquadrano queste prime tre mancanze, non posso andare oltre.

Notte

[Flash30005]

Prova (modificata solo TrovaAgg)

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 + 30
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 And Trim(Trim(Ws2.Cells(RR1, 14).Value)) <> "Sto" Then  '<<< ULTIMA STRINGA INSERITA

'If Ws2.Cells(RR1, 12).Value < Ws1.Range("A2").Value And Trim(Ws2.Cells(RR1, 12).Value) = "Att" Then   '<<< SOSTITUITA STRINGA - 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(Ws2.Cells(RR1, 11).Value) < 5 Then
            If Len(Ambo) > 5 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"
           
                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("K" & RR1 + 1).ClearContents
                Ws2.Range("I" & RR1 + 1).Value = Ws1.Range("A2").Value
                Ws2.Range("L" & RR1 + 1).Value = Ws1.Range("A2").Value
                Ws2.Range("M" & RR1 + 1).Value = CDate(Ws1.Range("B2").Value)
                Ws2.Range("J" & RR1 + 1).Value = 0 'DiffRit
                Ws2.Range("N" & RR1 + 1).Value = "Att"
                Ws2.Range("O" & RR1 + 1).ClearContents
                Ws2.Range("P" & RR1 + 1).Value = "in corso"
                Ws2.Range("R" & RR1 + 1).Value = 1
                Ws2.Range("S" & RR1 + 1).Value = 0
               
             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
End If
Next RR1
Next CCA
If AggS = 1 Then TrovaSpia
End Sub

[Lucio Peruggini]

Buona giornata
Intanto anticipo gli auguri per un buon anno nuovo a tutti.

Premetto che t’invio il foglio intero, faccio prima; piuttosto che inserire immagini.

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

Ciao Flash, ho inserito solamente la 8748 e già qui e prima di andare oltre, bisogna risolvere la situazione sulla ripetizione della spia che, è giustamente inserita nella colonna “C” ma nelle colonne “R:U” non sono marcati ne il gruppo, ne i ritardi che ho inserito io manualmente e colorati di giallo. In questo caso si tratta esclusivamente di gruppi (due); non può essere diversamente con una sola estrazione aggiunta.

Colonna “C” riga 64 vi è la prima spia ripetuta (num. 53); trattandosi di un gruppo le celle superiori che riguardano la prima spia uscita che era “univoca”, ora devono essere vuote.

Riga 67 (num. 55), idem come sopra.

Riga 75 (num. 61), in questo caso le celle superiori sono vuote; mancano come gli altri i valori in “R:U”.

Riga 86 (num. 69), come riga 75.

Riga 88 (num. 70), come riga 64; le celle superiori devono essere vuote.

Ciao

[Flash30005]

Ok
Adesso mandami il file con gli stessi dati ma con i valori giusti nelle celle da te menzionate
Cioè come vorresti che fosse, perché non ho capito nulla

[Flash30005]

Volevo precisare che nel file da te inviato non esiste più nemmeno la macro TrovaNS che fa proprio quello che vorresti
Non vorrei che hai dimenticato di lanciarla

ciao

[Lucio Peruggini]

Ok, invio il file come deve presentarsi alla 8748. Ho solamente eliminato i valori sulle celle superiori che hanno formato i gruppi due.

Allego anche questa immagine laddove sono raffigurate dall’alto in basso sei formazioni di spia ripetuta e commento le colonne “R:U” solamente per il gruppo sei.

https://dl.dropboxusercontent.com/u/182 ... GRUPPI.PNG

Numero 14 (gruppo 6)
Prima spia uscita estrazione 8723 (a quel momento era univoca); colonna “I”.
Seconda spia ripetuta 8754 (ha formato un gruppo due).
Terza spia ripetuta 8762 (ha formato un gruppo tre).
Quarta spia ripetuta 8776 (ha formato un gruppo quattro).
Quinta spia ripetuta 8777 (ha formato un gruppo cinque).
Sesta spia ripetuta 8780 a ritardo “0” senza che ci sia stato esito positivo fra la prima e la sesta ripetizione.
Abbiamo dunque un gruppo sei “Att” alla 8780, ultima in archivio.

Colonne “R:U”.

R48 = 6 colonna “C” (gruppo che si è formato dalla prima all’ultima spia uscita) ancora attuale.
S48 = 0 colonna “J” (ritardo ultima spia uscita).
T48 = 57 colonna “I” (ritardo accumulato dalla prima all’ultima spia) 8780-8763.
U48 = 57 è la differenza fra T - S. Ovviamente avendo “S” ritardo zero (spia ripetuta, avremo il medesimo valore di “T”.
Infatti, se guardi i valori di una spia non ripetuta nell’ultima estrazione la 8780, sono diversi.

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

Ciao