Condividi:        

MACRO O FORMULA

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: MACRO O FORMULA

Postdi Lucio Peruggini » 23/11/12 00:07

Non ho ben capito, mi faresti un esempio pratico?
Intanto, vista la tua bravura e grande disponibilità, puoi vedere come ottenere la somma di 11 ritardi consecutivi (compresa quella dell'attuale)? Probabilmente su un foglio di appoggio?
Ciao
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Sponsor
 

Re: MACRO O FORMULA

Postdi Flash30005 » 23/11/12 01:04

Per quanto riguarda l'elaborazione penso sia inutile rielaborare l'intero archivio
visto che è suddiviso in range di 18 estrazioni e la prima fornisce i dati per la seconda e così via
A questo punto è sufficiente rielaborare solo dall'ultima in poi
e sapere qual'è l'ultima è semplice perché in CZn ci sarà l'ultima elaborazione effettuata
se aggiungi 1 o 10,100 estrazioni non elaborate si può partire da CZn e arrivare a CZx

Mentre non capisco cosa intendi per
Lucio Peruggini ha scritto:ottenere la somma di 11 ritardi consecutivi (compresa quella dell'attuale)?


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: MACRO O FORMULA

Postdi Lucio Peruggini » 23/11/12 01:23

GRANDE FLESH
Ok, ho capito cosa intendi.

I dati ricavati e visivamente disponibili mi hanno permesso una valutazione molto particolare sui ritardi consecutivi che accennavo che sono diversi dai classici.
Si tratta di sommare l’intervallo non più, di dieci ritardi consecutivi ma solamente sei; compresso il ritardo attuale del numero in questione. Questi li prenderemo dalla colonna “J alla CU” e saranno solamente gli ultimi sei di un range ipotetico dell’estrazione.
Esempio, numero 1 ruota Bari.
Ultima estrazione in archivio 8615
Da qui, contiamo indietro fino a trovare il primo 1
J3601….. Att. 16
J3598…..rit….3
J3536…..rit….62
J3428…..rit….108
J3416…..rit….12
J3366…..rit….51
Somma……….252

Avrei pensato di inserire sopra, una riga sotto i numeri da 1 a 90 dove visualizzare la somma di questi ritardi. Vi è un inghippo:
Se voglio controllare indietro, come ottenere la somma di questi ritardi? Naturalmente qui nulla centra il ritardo attuale.

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

Re: MACRO O FORMULA

Postdi Flash30005 » 23/11/12 02:12

Ok
allora aggiungi una riga sotto alla numerazione 1-90 delle colonne J:CU

A questo punto va modificata la macro precedente in quanto l'inizio archivio non si trova più nella riga 2 ma 3, quindi...
Codice: Seleziona tutto
Sub ContaUnici2()
Start = Timer
Application.ScreenUpdating = False
Application.Calculation = xlManual
For FF = 1 To Worksheets.Count
If Len(Sheets(FF).Name) > 2 Then GoTo SaltaFF
Sheets(FF).Select
UR1 = Range("A" & Rows.Count).End(xlUp).Row
Range("CZ18:GK" & UR1).ClearContents
For RR1 = 3 To UR1 - 18 Step 18
    For NR = 1 To 90
        MyPre = Evaluate("=SUM(COUNTIF(B" & RR1 & ":F" & RR1 + 17 & "," & NR & "))")
        If MyPre = 1 Then
            UC1 = Cells(RR1 + 17, Columns.Count).End(xlToLeft).Column + 1
            If UC1 < 104 Then UC1 = 104
            Cells(RR1 + 17, UC1).Value = NR
        End If
    Next NR
Next RR1
UR2 = Range("CZ" & Rows.Count).End(xlUp).Row
For RR2 = 20 To UR2 Step 18
    UC2 = Cells(RR2, Columns.Count).End(xlToLeft).Column
    For CC2 = 104 To UC2
        NR = Cells(RR2, CC2).Value
        MyPre = Evaluate("=SUM(COUNTIF(B" & RR2 + 1 & ":F" & RR2 + 18 & "," & NR & "))")
        Cells(RR2 - 1, CC2).Value = MyPre
        If MyPre > 0 Then
            For RR3 = RR2 + 1 To RR2 + 18
                MyPre3 = Evaluate("=SUM(COUNTIF(B" & RR3 & ":F" & RR3 & "," & NR & "))")
                If MyPre3 = 1 Then Cells(RR3, NR + 9).Value = NR
            Next RR3
        End If
    Next CC2
Next RR2
SaltaFF:
Next FF
Sheets("BA").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Fine = Timer - Start
MsgBox "Elaborato in " & Int(Fine) & " sec"
End Sub


Ora aggiungerai questa macro per la somma ritardi a sei ultimi
Codice: Seleziona tutto
Sub ContaRitardi()
Start = Timer
Application.ScreenUpdating = False
Application.Calculation = xlManual
For FF = 1 To Worksheets.Count
    If Len(Sheets(FF).Name) > 2 Then GoTo SaltaFF
    Sheets(FF).Select
    UR1 = Range("A" & Rows.Count).End(xlUp).Row
    For NR = 1 To 90
        ContaEv = 0
        For RR1 = UR1 To 3 Step -1
            If Cells(RR1, NR + 9).Value <> "" Then
                ContaEv = ContaEv + 1
                If ContaEv = 6 Then
                    Cells(2, NR + 9).Value = UR1 - RR1 + 1
                    GoTo SaltaNR
                End If
            End If
        Next RR1
SaltaNR:
    Next NR
SaltaFF:
Next FF
Sheets("BA").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Fine = Timer - Start
MsgBox "Elaborato in " & Int(Fine) & " sec"
End Sub

Ricorda che questa seconda macro funziona solo se è stata avviata la precedente (la tabella J:CU deve avere i numeri riportati).

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: MACRO O FORMULA

Postdi Lucio Peruggini » 23/11/12 04:01

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

Re: MACRO O FORMULA

Postdi Flash30005 » 23/11/12 07:36

ok
Ora, con questa macro aggiornerai solo le estrazioni aggiunte (dopo l'ultima elaborazione).
Codice: Seleziona tutto
Sub ContaUniciAgg()
Start = Timer
Application.ScreenUpdating = False
Application.Calculation = xlManual
For FF = 1 To Worksheets.Count
If Len(Sheets(FF).Name) > 2 Then GoTo SaltaFF
Sheets(FF).Select
UR1 = Range("A" & Rows.Count).End(xlUp).Row
UR2 = Range("CZ" & Rows.Count).End(xlUp).Row
For RR1 = UR2 To UR1 - 18 Step 18
    For NR = 1 To 90
        MyPre = Evaluate("=SUM(COUNTIF(B" & RR1 & ":F" & RR1 + 17 & "," & NR & "))")
        If MyPre = 1 Then
            UC1 = Cells(RR1 + 17, Columns.Count).End(xlToLeft).Column + 1
            If UC1 < 104 Then UC1 = 104
            Cells(RR1 + 17, UC1).Value = NR
        End If
    Next NR
Next RR1
UR2 = Range("CZ" & Rows.Count).End(xlUp).Row
For RR2 = UR2 To UR1 Step 18
    UC2 = Cells(RR2, Columns.Count).End(xlToLeft).Column
    For CC2 = 104 To UC2
        NR = Cells(RR2, CC2).Value
        MyPre = Evaluate("=SUM(COUNTIF(B" & RR2 + 1 & ":F" & RR2 + 18 & "," & NR & "))")
        Cells(RR2 - 1, CC2).Value = MyPre
        If MyPre > 0 Then
            For RR3 = RR2 + 1 To RR2 + 18
                MyPre3 = Evaluate("=SUM(COUNTIF(B" & RR3 & ":F" & RR3 & "," & NR & "))")
                If MyPre3 = 1 Then Cells(RR3, NR + 9).Value = NR
            Next RR3
        End If
    Next CC2
Next RR2
SaltaFF:
Next FF
ContaRitardi
Sheets("BA").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Fine = Timer - Start
MsgBox "Elaborato in " & Int(Fine) & " sec"
End Sub


Ripropongo la macro che elabora l'intero archivio per aver inserito un messaggio di avviso (la macro sostituisce interamente "ContaUnici2").
Codice: Seleziona tutto
Sub ContaUnici()
Risp = MsgBox(Prompt:="Attenzione stai per cancellare i dati già elaborati - Continuo?", Buttons:=vbYesNo)
If Risp = 6 Then
Start = Timer
Application.ScreenUpdating = False
Application.Calculation = xlManual
For FF = 1 To Worksheets.Count
If Len(Sheets(FF).Name) > 2 Then GoTo SaltaFF
Sheets(FF).Select
UR1 = Range("A" & Rows.Count).End(xlUp).Row
Range("CZ18:GK" & UR1).ClearContents
Range("J21:CU" & UR1).ClearContents
For RR1 = 3 To UR1 - 18 Step 18
    For NR = 1 To 90
        MyPre = Evaluate("=SUM(COUNTIF(B" & RR1 & ":F" & RR1 + 17 & "," & NR & "))")
        If MyPre = 1 Then
            UC1 = Cells(RR1 + 17, Columns.Count).End(xlToLeft).Column + 1
            If UC1 < 104 Then UC1 = 104
            Cells(RR1 + 17, UC1).Value = NR
        End If
    Next NR
Next RR1
UR2 = Range("CZ" & Rows.Count).End(xlUp).Row
For RR2 = 20 To UR2 Step 18
    UC2 = Cells(RR2, Columns.Count).End(xlToLeft).Column
    For CC2 = 104 To UC2
        NR = Cells(RR2, CC2).Value
        MyPre = Evaluate("=SUM(COUNTIF(B" & RR2 + 1 & ":F" & RR2 + 18 & "," & NR & "))")
        Cells(RR2 - 1, CC2).Value = MyPre
        If MyPre > 0 Then
            For RR3 = RR2 + 1 To RR2 + 18
                MyPre3 = Evaluate("=SUM(COUNTIF(B" & RR3 & ":F" & RR3 & "," & NR & "))")
                If MyPre3 = 1 Then Cells(RR3, NR + 9).Value = NR
            Next RR3
        End If
    Next CC2
Next RR2
SaltaFF:
Next FF
ContaRitardi
Sheets("BA").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Fine = Timer - Start
MsgBox "Elaborato in " & Int(Fine) & " sec"
End If
End Sub


Ambedue le macro avviano "ContaRitardi"
che ripropongo per intero in quanto è stato eliminato il messaggio conteggio tempo
Codice: Seleziona tutto
Sub ContaRitardi()
'Start = Timer
Application.ScreenUpdating = False
Application.Calculation = xlManual
For FF = 1 To Worksheets.Count
    If Len(Sheets(FF).Name) > 2 Then GoTo SaltaFF
    Sheets(FF).Select
    UR1 = Range("A" & Rows.Count).End(xlUp).Row
    For NR = 1 To 90
        ContaEv = 0
        For RR1 = UR1 To 3 Step -1
            If Cells(RR1, NR + 9).Value <> "" Then
                ContaEv = ContaEv + 1
                If ContaEv = 6 Then
                    Cells(2, NR + 9).Value = UR1 - RR1 + 1
                    GoTo SaltaNR
                End If
            End If
        Next RR1
SaltaNR:
    Next NR
SaltaFF:
Next FF
Sheets("BA").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
'Fine = Timer - Start
'MsgBox "Elaborato in " & Int(Fine) & " sec"
End Sub

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: MACRO O FORMULA

Postdi Lucio Peruggini » 23/11/12 12:26

Ciao Flash e come sempre ti ringrazio per quanto stai facendo.

Fammi capire: Inserisco dunque queste ultime due?

Così facendo se volessi adoperare un nuovo file archivio iniziando dalla 3950 non marcherebbe più dall'inizio ma solo l'ultimo ciclo?
Ciao
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: MACRO O FORMULA

Postdi Flash30005 » 23/11/12 14:16

si così dovrebbe fare, ma testalo tu

ciao

P.s. appena ho tempo creo l'aggiornamento archivio automatico
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: MACRO O FORMULA

Postdi Lucio Peruggini » 23/11/12 14:21

Buona giornata

Ci sarebbe ancora qualcosa da inserire molto importante ai fini della ricerca stessa.
Avrei la necessità di colorare (unico colore) tutti i numeri che hanno zero uscite da CZ19 e verso destra, fino a quando l’ultimo d’essi non sia uscito nel range prestabilito nelle colonne B:F.
Nel file allegato vi è solo un foglio con ruota Bari ma quello completo a tutte le ruote e quindi bisogna tener conto anche degli altri nove fogli dove farò la stessa ricerca.
Solo per delucidazioni, le due righe 19 e 20 in colonna CZ calcolano:
La 20, tutti i numeri univoci che si trovano nel range B3:F20.
La 19, marca gli univoci usciti nel ciclo successivo (B21:F39) e quante volte il numero si è ripetuto.

Specificato ciò, avrei la necessità di seguire i numeri rimasti, quelli con zero “0” uscita come su spiegato.

Esempio pratico:

Quelli usciti (CZ20………….) la macro li ha già calcolati e marcati nel ciclo di 18 estrazioni successive B21:F39.
Dalla riga successiva in poi e per 72 estrazioni consecutive, B39:F110 devo colorare per l’appunto gli univoci rimasti a zero “0” uscite.

I numeri rimasti (zero uscite) alla fine del primo ciclo esaminato B21:F39 sono:

CZ19………………….| 11-12-17-19-20-21-24-26-27-33-34-38-41-44-51-59-83-86-90.

Come fare per colorare questi numeri sapendo che, devo poter cambiare anche lo step fra una ricerca e l’altra?
Probabilmente due pulsanti comandati da macro (inizio e fine) risolverebbero la situazione, non saprei.

https://dl.dropbox.com/u/18220462/FILE/ ... RUM%29.zip


Grazie per il grandissimo aiuto!!!
Ciao :roll:
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: MACRO O FORMULA

Postdi Flash30005 » 23/11/12 16:13

Ehmmmm :roll:

Penso sia alquanto caotico poter "seguire" lo sfaldamento colorando i numeri dell'archivio
anche perché ora hai definto un range che ti interessa e si potrebbe fare una macro per questo range
ma un domani che cambi il range (l'estrazione inizio studio)?

Allora avrei pensato di modificare le macro precedenti che ripropongo (tutte e tre)
Codice: Seleziona tutto
Sub ContaUnici()
Risp = MsgBox(Prompt:="Attenzione stai per cancellare i dati già elaborati - Continuo?", Buttons:=vbYesNo)
If Risp = 6 Then
Start = Timer
Application.ScreenUpdating = False
Application.Calculation = xlManual
For FF = 1 To Worksheets.Count
If Len(Sheets(FF).Name) > 2 Then GoTo SaltaFF
Sheets(FF).Select
UR1 = Range("A" & Rows.Count).End(xlUp).Row
Range("CX3:GK" & UR1).ClearContents
Range("J3:CU" & UR1).ClearContents
For RR1 = 3 To UR1 - 18 Step 18
    For NR = 1 To 90
        MyPre = Evaluate("=SUM(COUNTIF(B" & RR1 & ":F" & RR1 + 17 & "," & NR & "))")
        If MyPre = 1 Then
            UC1 = Cells(RR1 + 17, Columns.Count).End(xlToLeft).Column + 1
            If UC1 < 104 Then UC1 = 104
            Cells(RR1 + 17, UC1).Value = NR
        End If
    Next NR
Next RR1
UR2 = Range("CZ" & Rows.Count).End(xlUp).Row
For Passo = 1 To 5
For RR2 = 20 To UR2 Step 18
    UC2 = Cells(RR2, Columns.Count).End(xlToLeft).Column
    For CC2 = 104 To UC2
        NR = Cells(RR2, CC2).Value
       
        If Passo = 1 Then
            MyPre = Evaluate("=SUM(COUNTIF(B" & (RR2 + 1) + (Passo - 1) * 18 & ":F" & (RR2 + 18) + (Passo - 1) * 18 & "," & NR & "))")
            Cells(RR2 - 1 - (Passo - 1), CC2).Value = MyPre
            If MyPre > 0 Then
                For RR3 = RR2 + 1 To RR2 + 18
                    MyPre3 = Evaluate("=SUM(COUNTIF(B" & RR3 & ":F" & RR3 & "," & NR & "))")
                    If MyPre3 = 1 Then Cells(RR3, NR + 9).Value = NR
                Next RR3
            End If
            Range("CX" & RR2 - 1 - (Passo - 1)).Value = Passo * 18
        Else
            myform = "=MAX(R" & RR2 - 1 & "C" & CC2 & ":R" & RR2 - Passo + 1 & "C" & CC2 & ")"
            If Application.ReferenceStyle = xlA1 Then myform = Application.ConvertFormula(myform, xlR1C1, xlA1)
            MyMax = Evaluate(myform)
            If MyMax = 0 Then
                MyPre = Evaluate("=SUM(COUNTIF(B" & (RR2 + 1) + (Passo - 1) * 18 & ":F" & (RR2 + 18) + (Passo - 1) * 18 & "," & NR & "))")
                Cells(RR2 - 1 - (Passo - 1), CC2).Value = MyPre
                Range("CX" & RR2 - 1 - (Passo - 1)).Value = Passo * 18
            End If
       
        End If
    Next CC2
Next RR2
Next Passo

SaltaFF:
Next FF
ContaRitardi
Sheets("BA").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Fine = Timer - Start
MsgBox "Elaborato in " & Int(Fine) & " sec"
End If
End Sub

Sub ContaUniciAgg()
Start = Timer
Application.ScreenUpdating = False
Application.Calculation = xlManual
For FF = 1 To Worksheets.Count
If Len(Sheets(FF).Name) > 2 Then GoTo SaltaFF
Sheets(FF).Select
UR1 = Range("A" & Rows.Count).End(xlUp).Row
UR2 = Range("CZ" & Rows.Count).End(xlUp).Row
For RR1 = UR2 To UR1 - 18 Step 18
    For NR = 1 To 90
        MyPre = Evaluate("=SUM(COUNTIF(B" & RR1 & ":F" & RR1 + 17 & "," & NR & "))")
        If MyPre = 1 Then
            UC1 = Cells(RR1 + 17, Columns.Count).End(xlToLeft).Column + 1
            If UC1 < 104 Then UC1 = 104
            Cells(RR1 + 17, UC1).Value = NR
        End If
    Next NR
Next RR1
UR2 = Range("CZ" & Rows.Count).End(xlUp).Row
For Passo = 1 To 5
For RR2 = UR2 To UR1 Step 18
    UC2 = Cells(RR2, Columns.Count).End(xlToLeft).Column
    For CC2 = 104 To UC2
        NR = Cells(RR2, CC2).Value
        If Passo = 1 Then
            MyPre = Evaluate("=SUM(COUNTIF(B" & RR2 + 1 & ":F" & RR2 + 18 & "," & NR & "))")
            Cells(RR2 - 1, CC2).Value = MyPre
            If MyPre > 0 Then
                For RR3 = RR2 + 1 To RR2 + 18
                    MyPre3 = Evaluate("=SUM(COUNTIF(B" & RR3 & ":F" & RR3 & "," & NR & "))")
                    If MyPre3 = 1 Then Cells(RR3, NR + 9).Value = NR
                    Range("CX" & RR2 - 1 - (Passo - 1)).Value = Passo * 18
                Next RR3
            End If
           
        Else
            myform = "=MAX(R" & RR2 - 1 & "C" & CC2 & ":R" & RR2 - Passo + 1 & "C" & CC2 & ")"
            If Application.ReferenceStyle = xlA1 Then myform = Application.ConvertFormula(myform, xlR1C1, xlA1)
            MyMax = Evaluate(myform)
            If MyMax = 0 Then
                MyPre3 = Evaluate("=SUM(COUNTIF(B" & (RR2 + 1) + (Passo - 1) * 18 & ":F" & (RR2 + 18) + (Passo - 1) * 18 & "," & NR & "))")
                Cells(RR2 - 1 - (Passo - 1), CC2).Value = MyPre3
                Range("CX" & RR2 - 1 - (Passo - 1)).Value = Passo * 18
            End If
       
        End If
    Next CC2
Next RR2
Next Passo
SaltaFF:
Next FF
ContaRitardi
Sheets("BA").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Fine = Timer - Start
MsgBox "Elaborato in " & Int(Fine) & " sec"
End Sub
Sub ContaRitardi()
'Start = Timer
Application.ScreenUpdating = False
Application.Calculation = xlManual
For FF = 1 To Worksheets.Count
    If Len(Sheets(FF).Name) > 2 Then GoTo SaltaFF
    Sheets(FF).Select
    UR1 = Range("A" & Rows.Count).End(xlUp).Row
    For NR = 1 To 90
        ContaEv = 0
        For RR1 = UR1 To 3 Step -1
            If Cells(RR1, NR + 9).Value <> "" Then
                ContaEv = ContaEv + 1
                If ContaEv = 6 Then
                    Cells(2, NR + 9).Value = UR1 - RR1 + 1
                    GoTo SaltaNR
                End If
            End If
        Next RR1
SaltaNR:
    Next NR
SaltaFF:
Next FF
Sheets("BA").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
'Fine = Timer - Start
'MsgBox "Elaborato in " & Int(Fine) & " sec"
End Sub

Inseriscele nel modulo in sostituzione delle precedenti
La prima volta dovrai avviare la macro "ContaUnici"
nelle volte successive, invece, la macro "ContaUniciAgg"

E poi guarda i risultati da CX a destra. ;)

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: MACRO O FORMULA

Postdi Lucio Peruggini » 23/11/12 16:31

Flash30005 ha scritto:si così dovrebbe fare, ma testalo tu

ciao

P.s. appena ho tempo creo l'aggiornamento archivio automatico



Ho inserito queste ultime due macro e, facendo partire la prima macro mi viene fuori il messaggio di avviso "Attenzione, stai per cancellare i dati esistenti vuoi proseguire?"

Ho risposto Si! Mi ha rifatto di nuovo tutti i calcoli dall'inizio. <<<<<<niente di strano dunque.
L'inghippo sarebbe sorto se questa macro mi faceva solo l'ultimo ciclo, cancellando i precedenti.

Comunque, quando si potrà aggiornare in automatico, tieni sempre a mente gli step di inizio ricerca (cioè quante estrazioni considerare)!

Abbiamo però un grosso problema: così com'è impostata la ricerca, arriviamo al penultimo ciclo per vedere cosa succede in quello successivo. Questa è stata una mia mancanza di valutazione (sbagliata).
In realtà dovrebbe agire inversamente: iniziare il conteggio cicli dall'ultima estrazione in archivio e quindi andando indietro di diciotto in diciotto. :undecided:

Ciao e scusami per l'errata valutazione.
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: MACRO O FORMULA

Postdi Flash30005 » 23/11/12 16:35

Cioè?
Mi stai dicendo che dovrei rifare tutto? :aaah

Per conto mio rimane così!
Tanto... ai fini del Lotto è la stessa cosa! :D
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: MACRO O FORMULA

Postdi Lucio Peruggini » 23/11/12 17:03

No, VA PIU' CHE BENE!!!!! :)
Anzi con l'ultima modifica hai superato te stesso. Che dire: MAGNIFICO! : :)
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: MACRO O FORMULA

Postdi Lucio Peruggini » 23/11/12 18:56

Ciao Flash. in CW20 e seguenti, aggiungeresti gentilmente i numeri univoci totali,
e quanti ne rimangono nei cicli 18 e 36 "0"?

https://dl.dropbox.com/u/18220462/IMMAG ... stanti.PNG

E' una chicca, lo so ma molto utile.
Grazie ciao
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: MACRO O FORMULA

Postdi Flash30005 » 24/11/12 02:35

Ok
Sostituisci le due macro (lascia solo "ContaRitardi")
Codice: Seleziona tutto
Sub ContaUnici()
Risp = MsgBox(Prompt:="Attenzione stai per cancellare i dati già elaborati - Continuo?", Buttons:=vbYesNo)
If Risp = 6 Then
Start = Timer
Application.ScreenUpdating = False
Application.Calculation = xlManual
For FF = 1 To Worksheets.Count
If Len(Sheets(FF).Name) > 2 Then GoTo SaltaFF
Sheets(FF).Select
UR1 = Range("A" & Rows.Count).End(xlUp).Row
Range("CV3:GK" & UR1).ClearContents
Range("J3:CU" & UR1).ClearContents
For RR1 = 3 To UR1 - 18 Step 18
    For NR = 1 To 90
        MyPre = Evaluate("=SUM(COUNTIF(B" & RR1 & ":F" & RR1 + 17 & "," & NR & "))")
        If MyPre = 1 Then
            UC1 = Cells(RR1 + 17, Columns.Count).End(xlToLeft).Column + 1
            If UC1 < 104 Then UC1 = 104
            Cells(RR1 + 17, UC1).Value = NR
        End If
    Next NR
Next RR1
UR2 = Range("CZ" & Rows.Count).End(xlUp).Row
For Passo = 1 To 5
For RR2 = 20 To UR2 Step 18
    UC2 = Cells(RR2, Columns.Count).End(xlToLeft).Column
    For CC2 = 104 To UC2
        NR = Cells(RR2, CC2).Value
       
        If Passo = 1 Then
            MyPre = Evaluate("=SUM(COUNTIF(B" & (RR2 + 1) + (Passo - 1) * 18 & ":F" & (RR2 + 18) + (Passo - 1) * 18 & "," & NR & "))")
            Cells(RR2 - 1 - (Passo - 1), CC2).Value = MyPre
            If MyPre > 0 Then
                For RR3 = RR2 + 1 To RR2 + 18
                    MyPre3 = Evaluate("=SUM(COUNTIF(B" & RR3 & ":F" & RR3 & "," & NR & "))")
                    If MyPre3 = 1 Then Cells(RR3, NR + 9).Value = NR
                Next RR3
            End If
            Range("CX" & RR2 - 1 - (Passo - 1)).Value = Passo * 18
        Else
            myform = "=MAX(R" & RR2 - 1 & "C" & CC2 & ":R" & RR2 - Passo + 1 & "C" & CC2 & ")"
            If Application.ReferenceStyle = xlA1 Then myform = Application.ConvertFormula(myform, xlR1C1, xlA1)
            MyMax = Evaluate(myform)
            If MyMax = 0 Then
                MyPre = Evaluate("=SUM(COUNTIF(B" & (RR2 + 1) + (Passo - 1) * 18 & ":F" & (RR2 + 18) + (Passo - 1) * 18 & "," & NR & "))")
                Cells(RR2 - 1 - (Passo - 1), CC2).Value = MyPre
                Range("CX" & RR2 - 1 - (Passo - 1)).Value = Passo * 18
            End If
        End If
    Next CC2
    Range("CW" & RR2 - 1 - (Passo - 1)).Value = Evaluate("=SUM(COUNTIF(CZ" & RR2 - 1 - (Passo - 1) & ":IV" & RR2 - 1 - (Passo - 1) & "," & 0 & "))")
    Range("CW" & RR2).Value = Evaluate("=SUM(CW" & RR2 - 10 & ":CW" & RR2 - 1 & ")")
    Range("CV" & RR2).Value = "Tot"
Next RR2
Next Passo
SaltaFF:
Next FF
ContaRitardi
Sheets("BA").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Fine = Timer - Start
MsgBox "Elaborato in " & Int(Fine) & " sec"
End If
End Sub

Sub ContaUniciAgg()
Start = Timer
Application.ScreenUpdating = False
Application.Calculation = xlManual
For FF = 1 To Worksheets.Count
If Len(Sheets(FF).Name) > 2 Then GoTo SaltaFF
Sheets(FF).Select
UR1 = Range("A" & Rows.Count).End(xlUp).Row
UR2 = Range("CZ" & Rows.Count).End(xlUp).Row
For RR1 = UR2 To UR1 - 18 Step 18
    For NR = 1 To 90
        MyPre = Evaluate("=SUM(COUNTIF(B" & RR1 & ":F" & RR1 + 17 & "," & NR & "))")
        If MyPre = 1 Then
            UC1 = Cells(RR1 + 17, Columns.Count).End(xlToLeft).Column + 1
            If UC1 < 104 Then UC1 = 104
            Cells(RR1 + 17, UC1).Value = NR
        End If
    Next NR
Next RR1
UR2 = Range("CZ" & Rows.Count).End(xlUp).Row
For Passo = 1 To 5
For RR2 = UR2 - 18 * 5 To UR1 Step 18
    UC2 = Cells(RR2, Columns.Count).End(xlToLeft).Column
    For CC2 = 104 To UC2
        NR = Cells(RR2, CC2).Value
        If Passo = 1 Then
            MyPre = Evaluate("=SUM(COUNTIF(B" & RR2 + 1 & ":F" & RR2 + 18 & "," & NR & "))")
            Cells(RR2 - 1, CC2).Value = MyPre
            If MyPre > 0 Then
                For RR3 = RR2 + 1 To RR2 + 18
                    MyPre3 = Evaluate("=SUM(COUNTIF(B" & RR3 & ":F" & RR3 & "," & NR & "))")
                    If MyPre3 = 1 Then Cells(RR3, NR + 9).Value = NR
                    Range("CX" & RR2 - 1 - (Passo - 1)).Value = Passo * 18
                Next RR3
            End If
        Else
            myform = "=MAX(R" & RR2 - 1 & "C" & CC2 & ":R" & RR2 - Passo + 1 & "C" & CC2 & ")"
            If Application.ReferenceStyle = xlA1 Then myform = Application.ConvertFormula(myform, xlR1C1, xlA1)
            MyMax = Evaluate(myform)
            If MyMax = 0 Then
                MyPre3 = Evaluate("=SUM(COUNTIF(B" & (RR2 + 1) + (Passo - 1) * 18 & ":F" & (RR2 + 18) + (Passo - 1) * 18 & "," & NR & "))")
                Cells(RR2 - 1 - (Passo - 1), CC2).Value = MyPre3
                Range("CX" & RR2 - 1 - (Passo - 1)).Value = Passo * 18
            End If
        End If
    Next CC2
     Range("CW" & RR2 - 1 - (Passo - 1)).Value = Evaluate("=SUM(COUNTIF(CZ" & RR2 - 1 - (Passo - 1) & ":IV" & RR2 - 1 - (Passo - 1) & "," & 0 & "))")
    Range("CW" & RR2).Value = Evaluate("=SUM(CW" & RR2 - 10 & ":CW" & RR2 - 1 & ")")
    Range("CV" & RR2).Value = "Tot"
Next RR2
Next Passo
SaltaFF:
Next FF
ContaRitardi
Sheets("BA").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Fine = Timer - Start
MsgBox "Elaborato in " & Int(Fine) & " sec"
End Sub


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: MACRO O FORMULA

Postdi Lucio Peruggini » 24/11/12 14:37

MAGNIFICO!!!

Come ho già più volte affermato, spero vi accontentiate di un semplice GRAZIE ma è tutto quello che posso fare.

Un caro saluto e buona giornata
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: MACRO O FORMULA

Postdi Lucio Peruggini » 24/11/12 15:04

Scusa Flash, c'è stata una incomprensione sulla colonna degli univoci; il totale era riferito esattamente agli univoci "tutti" riga 20=49; riga 38=31.
Poi a scalare per ciclo quelli rimasti "0" che van bene.

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

Re: MACRO O FORMULA

Postdi Flash30005 » 24/11/12 15:54

Tutti?

Ma alla riga 20, non sono solo 49, ma saranno 300 se non più!?

Se vuoi tolgo la riga di questo conteggio e metti una formula Conta.se(tutto il range è uguale a 0)
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: MACRO O FORMULA

Postdi Lucio Peruggini » 24/11/12 16:04

Come sarebbe, 300 o più.

Alla riga 20 abbiamo gli univoci del range B3:F20 e sono un totale di 49; CZ20:EV20.
Ciao
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: MACRO O FORMULA

Postdi Flash30005 » 24/11/12 16:20

per come ho io il file sono 16 da B3 a F20
13 alla riga 19
2 alla riga 18
1 alla riga 17
Intendo i numeri con zero
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-

PrecedenteProssimo

Torna a Applicazioni Office Windows


Topic correlati a "MACRO O FORMULA":


Chi c’è in linea

Visitano il forum: Nessuno e 66 ospiti