PICCOLA AGGIUNTA SU MACRO

[Flash30005]

Ho confrontato i due file e ho notato che le colonne da A a P sono identici quindi le due macro "TrovaAgg" e "TrovaSpia" funzionano bene (conferma per questo)
I valori dalla colonna R alla colonna U sono diversi (macro TrovaNS) ma solo perché stai cambiando le specifiche ora, mi confermi?
In colonna S deve essere sempre 0 (zero) come nel file da te inviato?

Inoltre l'immagine inviata non corrisponde ai dati che sono sul file inviato "ComeDovrebbeEssere"
per fare quello che vuoi dovresti inviare il file come è nell'immagine e con ripristino all'estrazione precedente

Nota: Non dovevi chiamre questo topic "Piccola Aggiunta su macro"

[Lucio Peruggini]

Nota: Non dovevi chiamre questo topic "Piccola Aggiunta su macro"

Parto da quest'ultimo punto

In realtà ho utilizzato il medesimo topic perché inizialmente si è trattato effettivamente di una piccola aggiunta che riguardava la colonna "S" per gli univoci.

Ho confrontato i due file e ho notato che le colonne da A a P sono identici quindi le due macro "TrovaAgg" e "TrovaSpia" funzionano bene (conferma per questo)

Certo che andavano bene! L'inghippo è sorto dal momento in cui ho chiesto l'aggiunta di una riga agli eventi sfaldati per rimettere in gioco la cinquina e quindi la spia di pertinenza.

I valori dalla colonna R alla colonna U sono diversi (macro TrovaNS) ma solo perché stai cambiando le specifiche ora, mi confermi?

I valori sono diversi perché ho inserito tutte le novanta cinquine su Venezia proprio per ottenere quanto chiedevo. Ho fatto poi partire le estrazione da "0" dalla 8747 in modo che, mi sarei trovato all'ultima estrazione ora esistente la 8788 con dei gruppi già formati a ritardo 40-41 con cinquine non sfaldate.

In colonna S deve essere sempre 0 (zero) come nel file da te inviato?

Dev'essere "0" quando :
Si sfalda una cinquina e quindi si rimette in gioco la medesima.

Altre sì dev'essere "0" quando vi è la ripetizione di una spia.

Inoltre l'immagine inviata non corrisponde ai dati che sono sul file inviato "ComeDovrebbeEssere"

L'immagine inviata era per farti vedere oltre al gruppo due anche altri gruppi maggiori non ancora sfaldati.
Il file inviato è quello dove ho messo tutte le novanta cinquine, come su spiegato; la sostanza però non cambia.

per fare quello che vuoi dovresti inviare il file come è nell'immagine e con ripristino all'estrazione precedente

Nessun problema ad inviare il file della foto; l'ho inserisco! In questo file però non ci sono tutte le novanta cinquine.

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

E' ripristinato all'estrazione precedente la foto immessa. Basta inserire in archivio la 8780 e avrai quanto vedi Nell'immagine inviata prima.

Buon anno, ciao

[Flash30005]

Sostituisci la macro "TrovaNS" a quella esistente

Codice: Seleziona tutto

Sub TrovaNS()
Set Ws2 = Worksheets("Attuali")
UR = Ws2.Range("B" & Rows.Count).End(xlUp).Row
Ws2.Range("R8:U" & UR).ClearContents
MaxR = 0
ContaS = 1
For RR = 8 To UR
RuS1 = Trim(Ws2.Range("B" & RR).Value) & Trim(Ws2.Range("C" & RR).Value)
RuS2 = Trim(Ws2.Range("B" & RR + 1).Value) & Trim(Ws2.Range("C" & RR + 1).Value)
If RuS1 = RuS2 Then
If MaxR = 0 Then
MioMaxR = Ws2.Range("J" & RR).Value
MaxR = 1
End If
MinR = Ws2.Range("J" & RR + 1).Value
ContaS = ContaS + 1
Else
MaxR = 0
If ContaS > 0 Then
    Ws2.Range("R" & RR).Value = ContaS

    If ContaS > 1 Then
        Ws2.Range("S" & RR).Value = MinR
        Ws2.Range("T" & RR).Value = MioMaxR
        Ws2.Range("U" & RR).Value = MioMaxR - MinR
    End If
    ContaS = 1
End If
If Ws2.Range("R" & RR).Value > 0 Then Ws2.Range("S" & RR).Value = Ws2.Range("J" & RR).Value
End If
Next RR
End Sub

Ciao e Buon Anno a tutti!

[Lucio Peruggini]

Ciao Flash mi spiace ma non ci siamo!

https://dl.dropboxusercontent.com/u/182 ... ata%29.PNG

La macro non aggiorna gli eventi sfaldati; nel senso che non aggiunge la riga alle cinquine che hanno avuto evento positivo, cioè storici.
Siamo ritornati al punto di partenza laddove chiedevo proprio quest’aggiunta; anzi direi peggio!
I valori delle colonne “S e T” sono tutti errati.

S) Deve avere il medesimo valore di “J”; che sia zero, 10 o 50.
T) marca il ritardo massimo che ha la spia nella prima volta che è uscita; sempre colonna “J”.
U) Va bene!

La macro “Trova NS” che c’è nel foglio che ti ho inviato, andava benone (un po’ lenta) ma perfettamente funzionante.

Non capisco:
Mi rendo conto che probabilmente non hai sufficientemente tempo a disposizione ma, quando fai una correzione e visto che ti ho inviato il file, potresti almeno provare che tutto funzioni sulla base delle richieste e correzioni apportate?
Altrimenti che senso ha inviare un file dimostrativo?

Penso che si guadagnerebbe tempo prezioso e si eviterebbero ripetizioni spiegative.
Se poi non si fa perché il problema non si è afferrato completamente, il discorso è ancora peggiore; ci sarà sempre un anti-rivieni di spiegazioni che non fanno altro che confondere ancor più!

C’eri quasi arrivato ed ero felicissimo! Se non riesci (ma non credo), pazienza; lasciamo le cose come stanno.

Ciao e scusami se ti ho creato qualche problema.
Buon anno nuovo.

[Flash30005]

Faccio finta di non aver letto alcune frasi che hai scritto nell'ultimo post
La macro "TrovaNS" fa l'aggiornamento delle colonne R, S, T, U se la togli e non la usi chiaramente non avrai MAI i valori che vorresti
Ora indicami in questa immagine dove incontri errori, cerca di essere chiaro perché penso che a forza di stare appresso ai numeri tu stia cominciando a darli...



Uploaded with ImageShack.us

(Clicca sull'immagine per vederla interamente)

[Lucio Peruggini]

Ciao Flash, ho verificato ma temo che ci sia stata qualche incomprensione sulle varie correzione fatte.
E' vero, avevo eliminato dal foglio la macro "TrovaNS", mi era parso (mia cattiva interpretazione), che il tutto fosse stato racchiuso nelle macro (TrovaAgg e TrovaSpia). Ho comunque risistemato il tutto ma l'errore che avevo segnalato è sempre presente; nel senso che: le righe aggiunte "Storici" e quindi univoche, sono identificate dalla macro "TrovaNS" come gruppi due.

L'immagine che hai postata riporta i valori corretti; ma dimmi:
In questo foglio viene inserita anche la riga dopo gli eventi storici (aggiunta che avevo chiesto?). Se così fosse, allora ti prego d'inviarmelo e risolviamo la questione.

Se invece non inserisce la riga dopo gli storici e quindi non rimette in gioco la medesima cinquina sfaldata, cosa vuol dire:
Ci troviamo al punto di partenza?

Ciao

[Flash30005]

Prima di inviare il file completo e "velocizzato" dovresti confermarmi che questa immagine (stesso range dell'ultima da te inviata) riporti tutti i valori corretti


Uploaded with ImageShack.us

[Lucio Peruggini]

Sì, i valori sono giusti ma come anticipato, agli eventi sfaldati (storici) 8779 non hanno aggiunto la riga e quindi messo in gioco di nuovo la cinquina; che ripartirà da ritardo “0” come formazione “Univoca”. Questo ritardo chiaramente proviene dalla colonna “J” e deve corrispondere nelle “R:S” come: R=0 / S=1.
Tutti gli altri gruppi dovrebbero aggiornarsi correttamente incrementando di una unità i loro valori; tranne la colonna "R" che identifica il gruppo.

Inoltre, mi sono accorto che, cliccando più di una volta “G1” e azionando quindi le macro (Trova Agg e Trova Spia), reinserisce di nuovo i dati (situazione che avevi già risolto in precedenza e che andava bene).

Ciao

Dimenticanza:

Il foglio di cui immagine, funziona correttamente con le macro ANTE-CORREZIONI.
In tal senso i dati sono corretti!

[Flash30005]

Questo succede perché quando mi hai inviato l'ultimo file "Originale" dove avevamo risolto il problema della rimessa in gioco della cinquina pensavo che ci fosse la macro con l'ultima modifica da me fatta in TrovaAgg mentre tu mi hai rimandato la macro "vecchia"
ed è chiaro che non aggiunge la riga a 0 (zero).
Quindi ora prendi il file "originale" elimina tutti (TUTTI) i moduli che hai all'interno.
Crei un nuovo modulo che si chiamerà Modulo1 e incolli interamente il seguente 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 + 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"
            If Ws2.Range("C" & RR1 + 1).Value <> Ws2.Range("C" & RR1).Value Or Ws2.Range("B" & RR1 + 1).Value <> Ws2.Range("B" & RR1).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("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
            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
End If


Next RR1
Next CCA
If AggS = 1 Then TrovaSpia
TrovaNS
End Sub


Private 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

Private Sub TrovaNS()
Set Ws2 = Worksheets("Attuali")
UR = Ws2.Range("B" & Rows.Count).End(xlUp).Row
Ws2.Range("R8:U" & UR).ClearContents
MaxR = 0
ContaS = 1
For RR = 8 To UR
RuS1 = Trim(Ws2.Range("B" & RR).Value) & Trim(Ws2.Range("C" & RR).Value)
RuS2 = Trim(Ws2.Range("B" & RR + 1).Value) & Trim(Ws2.Range("C" & RR + 1).Value)
If RuS1 = RuS2 Then
If MaxR = 0 Then
MioMaxR = Ws2.Range("J" & RR).Value
MaxR = 1
End If
MinR = Ws2.Range("J" & RR + 1).Value
ContaS = ContaS + 1
Else
MaxR = 0
If ContaS > 0 Then
    Ws2.Range("R" & RR).Value = ContaS

    If ContaS > 1 Then
        Ws2.Range("S" & RR).Value = MinR
        Ws2.Range("T" & RR).Value = MioMaxR
        Ws2.Range("U" & RR).Value = MioMaxR - MinR
    End If
    ContaS = 1
End If
If Ws2.Range("R" & RR).Value > 0 Then Ws2.Range("S" & RR).Value = Ws2.Range("J" & RR).Value
End If
Next RR
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub




Ciao

[Lucio Peruggini]

Ciao Flash e buona giornata. Ci siamo quasi ma vi è qualche correzione come già segnalata, da apportare.

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

Innanzitutto sono partito dalla 8777 e già qui ho dovuto attivare la macro per sistemare il tutto partendo per l’appunto da “0” che in questo caso è la 8777.

Orbene, come asserito nell’ultimo post, la macro non riconosce l’ultima estrazione immessa (difetto che avevi già risolto in precedenza), di conseguenza aggiunge righe che non dovrebbe.

Nel file che ora t’invio, trovi un foglio aggiornato in modo corretto con l’ultima modifica. Basta quindi inserire questi dati nel foglio “Attuali” per partire sempre in modo corretto dalla 8777.
Nota: immessa questa estrazione in archivio, dopo aver inserito i dati di quest’ultima nel foglio “Attuali”, non attivare la macro altrimenti aggiungerebbe righe che non dovrebbe; come su detto.

Sono poi andato avanti e, alla 8778 non vi è stato nessun evento positivo e i dati sono stati aggiornati correttamente; fin qui tutto bene.

8779, ci sono stati quattro eventi positivi; righe 17-109-147-182.
E stata regolarmente aggiunta la riga che rimette in gioco la cinquina ma, nelle colonne “R:S” anziché avere eventi “univoci” (1 e 0) che ripartono da zero, continua a marcare il gruppo appena sfaldato.

Penso di aver eseguito tutto correttamente e quindi abbiamo due correzioni.

1) La macro non deve attivarsi se la colonna “L” è uguale a quella immessa in archivio.
2) La riga immesse dopo gli eventi sfaldati (storici) deve azzerarsi (cosa che già succede) ma deve essere “Univoca” con i dati immessi solamente in "R e S" che saranno: Uno e Zero.

Ciao e ancora grazie molte!

[Flash30005]

Inviami ora un'immagine di come dovrebbe essere la riga 17-109-147-182
relativa al file che mi hai appena inviato

[Lucio Peruggini]

Le immagini sono cinque, di cui le prime quattro sono una per gruppo sfaldato.
La quinta, li fa vedere insieme.
Ciao

https://dl.dropboxusercontent.com/u/182 ... %20R-S.PNG

https://dl.dropboxusercontent.com/u/182 ... %20R-S.PNG

https://dl.dropboxusercontent.com/u/182 ... %20R-S.PNG

https://dl.dropboxusercontent.com/u/182 ... %20R-S.PNG

https://dl.dropboxusercontent.com/u/182 ... %20R-S.PNG

[Lucio Peruggini]

Mi stava sfuggendo completamente:

Anche gli eventi sfaldati (storici) devono avere il resoconto, come prima ha sempre fatto; nelle colonne "R:U". Ovviamente non saranno più prese in considerazione con le estrazioni future.

Le ho marcate in verde.


https://dl.dropboxusercontent.com/u/182 ... %20R-S.PNG

https://dl.dropboxusercontent.com/u/182 ... %20R-S.PNG

https://dl.dropboxusercontent.com/u/182 ... %20R-S.PNG

https://dl.dropboxusercontent.com/u/182 ... %20R-S.PNG

Ciao

[Flash30005]

sostituisci tutto

Codice: Seleziona tutto

Sub TrovaAgg()
Set Ws1 = Worksheets("Archivio")
Set Ws2 = Worksheets("Attuali")
If Ws1.Range("B2").Value <= Ws2.Range("M1") Then Exit Sub
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"
            If Ws2.Range("C" & RR1 + 1).Value <> Ws2.Range("C" & RR1).Value Or Ws2.Range("B" & RR1 + 1).Value <> Ws2.Range("B" & RR1).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("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
            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
End If


Next RR1
Next CCA
If AggS = 1 Then TrovaSpia
TrovaNS
 Ws2.Range("M1") = Ws1.Range("B2").Value
End Sub


Private 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

Private Sub TrovaNS()
Set Ws2 = Worksheets("Attuali")
UR = Ws2.Range("B" & Rows.Count).End(xlUp).Row
Ws2.Range("R8:U" & UR).ClearContents
MaxR = 0
ContaS = 1
For RR = 8 To UR
RuS1 = Trim(Ws2.Range("B" & RR).Value) & Trim(Ws2.Range("C" & RR).Value)
RuS2 = Trim(Ws2.Range("B" & RR + 1).Value) & Trim(Ws2.Range("C" & RR + 1).Value)
If RuS1 = RuS2 Then
If MaxR = 0 Then
MioMaxR = Ws2.Range("J" & RR).Value
MaxR = 1
End If
MinR = Ws2.Range("J" & RR + 1).Value
ContaS = ContaS + 1
Else
MaxR = 0
If ContaS > 0 Then
Ws2.Range("R" & RR).Value = ContaS
   If Trim(Ws2.Range("N" & RR - 1).Value) = "Sto" Then Ws2.Range("R" & RR).Value = 1
    If ContaS > 1 Then
        Ws2.Range("S" & RR).Value = MinR
        Ws2.Range("T" & RR).Value = MioMaxR
        Ws2.Range("U" & RR).Value = MioMaxR - MinR
    End If
    ContaS = 1
End If
If Ws2.Range("R" & RR).Value > 0 Then Ws2.Range("S" & RR).Value = Ws2.Range("J" & RR).Value
End If
Next RR
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub



Inoltre devi togliere la formula nel foglio Attuali cella M1 (inizialmente metti 0)
questo evita di far avviare la macro più volte a parità di concorso

Ciao

[Lucio Peruggini]

Ciao Flash, oggi non ho avuto tempo e solo da un’ora mi sono messo dietro queste verifiche.

1) Ho sostituito le macro nel foglio “Originale”.
2) Ho immesso nel foglio “Attuali” i dati di partenza (quelli della 8777).
3) Ho inserito “0” in M1.
4) Ho controllato la quantità di eventi totali suddivisi fra i vari gruppi laddove e con i filtri in colonna “R” abbiamo per l’appunto come partenza quanto segue:

UNIVOCI 23 EVENTI
GRUPPO 2 19 EVENTI
GRUPPO 3 05 EVENTI
GRUPPO 4 05 EVENTI
GRUPPO 5 06 EVENTI
GRUPPO 6 06 EVENTI
GRUPPO 8 01 EVENTO
GRUPPO 13 01 EVENTO

A ritardo “0” (colonna “J” e di conseguenza anche in colonna “S”), ci sono cinque eventi di cui: tre univoci, un gruppo 2, un gruppo 5.
Il gruppo due che vedi colorato in azzurro mi era sfuggito; ora è apposto.

Orbene, ho provato a lanciare la macro che a questo punto non sarebbe dovuta partire, avendo la medesima estrazione in Archivio ma così non è stato.

Dalle due immagini allegate noterai che: la prima ha solamente cinque eventi a ritardo “0”, con i numeri spia di pertinenza che sono 13-14-60-71-88 colonna “C”, prima di eseguire la macro,

Nella seconda immagine e dopo aver lanciato la macro, questi si sono doppiati ma non avrebbero dovuto replicarsi avendo la medesima estrazione in archivio.

Ho forse sbagliato qualche passaggio? Non mi sembra.

Bisogna capire il perché altrimenti non posso proseguire se già in partenza non si hanno valori corretti.

Se lo ritieni opportuno, posso inviarti il file.

https://dl.dropboxusercontent.com/u/182 ... 0e%20S.PNG

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

Ciao

[Lucio Peruggini]

Ciao Flash, dalla correzione primaria alla 8777 che è indipendente da quanto segue, ho provato inserendo direttamente la 8778 e ho notato che non replica l’estrazione pur cliccando per attivare ancora la macro, ma:

Il problema segnalato dalle immagini precedenti, del post in data corrente delle ore 14.36, è tuttora esistente.
La riga aggiunta all’evento storico non è esatta; continua a marcare in T e U, ritardi che non fanno parte della stringa univoca appena immessa che sono R=1 / T=0.

Il gruppo storico e la riga aggiunta devono corrispondere all’immagine seguente:

https://dl.dropboxusercontent.com/u/182 ... %20R-S.PNG

Ora è così:

https://dl.dropboxusercontent.com/u/182 ... %C3%AC.PNG

Ciao

[Flash30005]

Sostituisci tutto (eliminando i moduli) e incolla in un modulo questo codice

Codice: Seleziona tutto

Sub TrovaAgg()
Set Ws1 = Worksheets("Archivio")
Set Ws2 = Worksheets("Attuali")
MaxC = Evaluate("=Max(L:L)")
If Ws2.Range("I1").Value <= MaxC Then Exit Sub
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"
            If Ws2.Range("C" & RR1 + 1).Value <> Ws2.Range("C" & RR1).Value Or Ws2.Range("B" & RR1 + 1).Value <> Ws2.Range("B" & RR1).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("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
            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
End If


Next RR1
Next CCA
If AggS = 1 Then TrovaSpia
TrovaNS
' Ws2.Range("M1") = Ws1.Range("B2").Value
End Sub


Private 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

Private Sub TrovaNS()
Set Ws2 = Worksheets("Attuali")
UR = Ws2.Range("B" & Rows.Count).End(xlUp).Row
Ws2.Range("R8:U" & UR).ClearContents
MaxR = 0
ContaS = 1
For RR = 8 To UR
RuS1 = Trim(Ws2.Range("B" & RR).Value) & Trim(Ws2.Range("C" & RR).Value)
RuS2 = Trim(Ws2.Range("B" & RR + 1).Value) & Trim(Ws2.Range("C" & RR + 1).Value)
If RuS1 = RuS2 Then
If MaxR = 0 Then
MioMaxR = Ws2.Range("J" & RR).Value
MaxR = 1
End If
'MinR = Ws2.Range("J" & RR + 1).Value
If Ws2.Range("J" & RR + 1) <> 0 Then MinR = Ws2.Range("J" & RR + 1).Value
ContaS = ContaS + 1
Else
MaxR = 0
If ContaS > 0 Then
Ws2.Range("R" & RR).Value = ContaS
    If Trim(Ws2.Range("N" & RR - 1).Value) = "Sto" Then
        Ws2.Range("R" & RR).Value = 1
        Ws2.Range("R" & RR - 1).Value = ContaS - 1
        Ws2.Range("S" & RR - 1).Value = MinR
        Ws2.Range("T" & RR - 1).Value = MioMaxR
        Ws2.Range("U" & RR - 1).Value = MioMaxR - MinR
   Else
    If ContaS > 1 Then
        Ws2.Range("S" & RR).Value = MinR
        Ws2.Range("T" & RR).Value = MioMaxR
        Ws2.Range("U" & RR).Value = MioMaxR - MinR
    End If
    End If
    ContaS = 1
End If
If Ws2.Range("R" & RR).Value > 0 Then Ws2.Range("S" & RR).Value = Ws2.Range("J" & RR).Value
End If
Next RR
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub



Puoi ripristinare la formula della data in M1 del foglio "Attuali" ho escogitato un altro sistema per evitare doppio avvio della macro

ciao

[Lucio Peruggini]

Ho sostituito il tutto ma non mi parte proprio! A te funziona? Se così fosse, mi mandi il foglio?

Hai sistemato anche quanto ho specificato nel post precedente?

Ciao

[Flash30005]

Eccolo!

[Lucio Peruggini]

Siamo quasi alla frutta! Ci sono però, due errori.

Il primo, riga 108 si è sfaldato come “Univoco” e quindi i valori in T-U non ci devono essere. In “S” invece, dev’esserci il ritardo 13 proveniente dalla colonna “J”.

Il secondo, riga 119 (la colonna “U”) riporta un valore dieci; dev’essere 24.

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

Altro per il momento non vedo; ho gli occhi gonfi e stanchi.

Buona notte, a domani. E come sempre infinitamente GRAZIE per il tempo che mi hai dedicato.
Ciao