CORTESEMENTE - UNA MACRO

[Flash30005]

Credo di aver capito il problema ma preferisco riproporti la macro "TrovaSpia" che stare a speigarlo

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 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
Ciao

[Lucio Peruggini]

Mi sono svegliato anzitempo e ho trovato questo bel dono di "macro completata". URRAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA!!!!!!!!!!!!

Penso sia arrivato il momento della passeggiata autunnale; a dire il vero mi hai proprio stimolato!

http://it.123rf.com/photo_22275376_fore ... olori.html

Grande Flash!
GRAZIE DI CUORE
Ciao

[Lucio Peruggini]

Buona giornata

Ho aggiunto al foglio le colonne da (R a V) che avevo tolto dal primo inviato e non mi funziona più la macro. Queste colonne interferiscono? Come potrei fare?
Esse mi servono poiché restituiscono i gruppi (spia ripetuta) colonna "S" insieme ai vari ritardi.
Mi dai gentilmente uno sguardo a questo foglio?

https://dl.dropboxusercontent.com/u/182 ... iunte.xlsm
Ciao

[Flash30005]

Sei sicuro di aver aggiunto solo le colonne a destra della tabella?

Io credo che tu abbia fatto altre modifiche come, ad esempio la data che ora è in questo formato "GG.MM.AAAA " (formato conosciuto solo da te), che oltre ad avere la punteggiatura come separatore ha anche un campo sporco dopo l'anno.
Inoltre La colonna K è piena di campi sporchi (spazi), questo campo deve essere pulito in quanto discrimina se è già stato utilizzato o no. se metti gli spazi la macro lo vede già aggiornato (come se ci fosse un ambo)
sistema queste date e ripulisci i campi, vedrai che tutto tornerà a funzionare

ciao

[Lucio Peruggini]

Ciao Flash, solo ora mi sono accorto (parlo del foglio rifatto nuovo) quello cioè dove avevo inserito due numeri fittizi per ruota e su Torino-Venezia incrementava solamente due numeri. Su questo file hai operato sistemando l'ultima correzione che poi ho scaricato ed è funzionante.

Vi è però un particolare:

Non sono io che ho cambiato il formato della data nel foglio "Attuali" che pur essendo diversa dopo aver lanciato la macro, è perfettamente funzionante. Infatti, se copi e incolli dal foglio "Originale degli attuali" ripartendo quindi dalla 8750, inserisci poi la 8751, noterai che cambia il formato della data ma, tutto funziona correttamente.

E' evidente che non centra il formato data nelle colonne aggiunte (R:V); ma forse sbaglio.
ciao

[Flash30005]

A parte la data, che viene sovrascritta, ci sono le celle nella colonna K piene di spazi spuri che non permettono la scrittura dell'ambo trovato ed ecco quindi il mancato aggiornamento.

Ho, comunque, modificato la macro (TrovaAgg) affinché possa superare questo ostacolo.

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(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 Len(Ws2.Cells(RR1, 11).Value) > 13 Then Ws2.Cells(RR1, 15).Value = "Quaterna"
             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

provala e fai sapere
ciao

[Lucio Peruggini]

L'ho provata e siamo ritornati a com'era prima; su Torino-Venezia manca una riga per parte.
Su venti spie ripetute alla 8751 ne incrementa solamente 18, colonna "J" rit. "0"

Ciao

[Flash30005]

Ora stai sbagliando qualcosa, magari hai utilizzato una macro precedente.
Ho fatto i test e con la 8751 originale su torino incrementa solo l'81 e su venezia solo il 77 come è giusto che faccia.
Se inserisco due numeri test (archivio) corrispondenti alle spie delle singole ruote ottengo l'aggiunta di due numeri per ruota.

ciao

[Lucio Peruggini]

Hai ragione! Avevo utilizzato una macro precedente; ora funziona tutto a meraviglia anche con le colonne aggiunte "Q:V" ma dimmi:
Se immetto in altro modulo la macro che processa le colonne "S:V" e quindi a lavoro terminato con la prima la lancio, dovrebbe funzionare giusto?
Ciao

[Lucio Peruggini]

Ciao Flash o chiunque voglia assemblare questa formula. Un’ultima cortesia a chiusura di questo magnifico lavoro.
Nell’immagine allegata ho aggiunto due colonne (Q-R), eliminando tutto il rimanente.

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

Nella colonna “Q” ho inserito la seguente formula che mette l’asterisco formando i gruppi ripetuti di un numero spia della colonna “C” con appartenenza alla propria ruota, che è questa:

Codice: Seleziona tutto

=SE(O(E(B8=B9;C8=C9;K8=K9;L8=L9);E(B7=B8;C7=C8;K7=K8;L7=L8));"*";"")

Nella colonna “R” vorrei specificare sempre con formula la quantità di ripetizioni che ha questo numero.

Avremo quindi:

Il dieci su Bari = due ripetizioni.
Il dodici = quattro ripetizioni.
Il trentaquattro e trentasette = due ripetizioni.
Il sessantadue = tre ripetizioni, etc. per tutto il foglio che contiene anche le altre ruote.

Grazie molte.

[Flash30005]

Prova questa macro

Codice: Seleziona tutto

Sub TrovaNS()
Set Ws2 = Worksheets("Attuali")
UR = Ws2.Range("B" & Rows.Count).End(xlUp).Row
Ws2.Range("S8:S" & UR).ClearContents
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
ContaS = ContaS + 1
Else
If ContaS > 1 Then
Ws2.Range("S" & RR).Value = ContaS
ContaS = 1
End If
End If
Next RR
End Sub

Ciao

[Lucio Peruggini]

Grazie anche per questa.
PERFETTO!!!
Ciao

[Lucio Peruggini]

Ciao Flash, ci sarebbe da aggiungere in colonna “R” (che ho spostato) era “S”, una piccola condizione.

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

Un numero spia che nell’estrazione precedente era “univoco”, nella successiva se si ripete divenendo un gruppo due, non può essere più uno.
Come vedi da immagine riga ventitré il 68 di Bari si è ripetuto; l’uno deve sparire.
Grazie e buona giornata

[Flash30005]

Se continui a modificare lo schema dei dati significa che sei in grado di adattare la macro da solo
oppure pensi che mi metta a modificare la macro ogni volta?
Inoltre come potrei intervenire senza avere il nuovo file?

Ti ricordo e ripeto fai che sia l'ultima modifica da fare,
quindi imposta definitivamente il tuo foglio per non intervenire più in futuro, ok?

[Lucio Peruggini]

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

Flash ti stai sbagliando; non ho modificato nessun foglio.

Se osservi bene l'immagine che ho inviato dove chiedevo la formula che marcasse i gruppi ripetuti delle spie, riporto ciò che ho scritto:


"Nella colonna “R” vorrei specificare sempre con formula la quantità di ripetizioni che ha questo numero."


Orbene, la macro marcava questi gruppi nella colonna "S" che ho spostato in "R".

Questo nulla centra con la condizione da implementare (ultima richiesta fatta), o sbaglio? Allego foglio, ciao.

[Lucio Peruggini]

Ad ogni modo capisco che evidentemente ho rotto un po troppo; GRAZIE PER TUTTO!
Saluti

Note: se fossi stato in grado di aggiustarmi da solo l'avrei già fatto, non credi?

[Flash30005]

Perdona ma non si comprende se in R (ex S) vuoi una formula oppure che la macro debba continuare a scrivere su di essa
In ogni caso se hai modificato la macro per il corretto funzionamento dovresti ottenere questo


Uploaded with ImageShack.us
ciao

[Lucio Peruggini]

Non capisco perché hai riesumato quello che era un discorso chiuso. Colonne A:P è ok!
Colonna “R” ultima macro (valori giusti). Tutto quello che segue, non centra più niente; come detto era un discorso finito. I valori (S_T_U) sono errati per questo foglio “Attuali”. Nei primi post di questa richiesta mi ero fermato alla colonna “P” proprio per non complicare la situazione oltremodo.

Comunque, lasciamo tutto così; ho risolto in questo modo:
Ho tolto anche gli asterischi giacché con l’ultima macro si possono marcare anche gli “univoci”.

If ContaS > 0 Then 'ERA >1
Ws2.Range("R" & RR).Value = ContaS 'ERA "S"

Un ultimo intervento su questa macro è di resettare la colonna “R” altrimenti quando si aggiungono righe, se una spia si ripete, il valore precedente rimane impresso.
FINITO, grazie.

EDITO.........
Chiedo scusa: resettare dalla riga otto in poi.

[Flash30005]

Codice: Seleziona tutto

Set Ws2 = Worksheets("Attuali")
UR = Ws2.Range("B" & Rows.Count).End(xlUp).Row
Ws2.Range("R8:R" & UR).ClearContents

[Lucio Peruggini]

Ciao Flash e grazie.
Perdona ma in quale punto della macro devo inserire questo codice che azzera la colonna?
Ciao


MI EDITO:

Ho risolto grazie.
Bastava semplicemente osservare il codice. Purtroppo in questo sono una vera frana!

GRAZIE MOLTE PER TUTTO!!!