i peggiori 45 ambi con 49 numeri

[raimea]

ciao
sfruttando la macro --- MIGLIORI_45 (che non ho fato tutta io),
vorrei realizzare la stessa cosa ma inversa
cioe' cercare i peggiori 45 ambi che sono stati realizzati
cioe' quelli meno frequenti

nel fgl ambi-ritr scrivere alla 1ma posiz DL10 l'ambo meno frequente
poi come 2da scelta il piu in ritardo attuale in col DN10,
e in DO10 il max ritardo

io ho provato a modificare la macro ma non ci sono riuscito

provo ad allegare il file
https://db.tt/lI5Kqw5B

ciao

[Anthony47]

Immagino che si parta dai dati contenuti in Archivio_UK49s, colonne A:H (quindi escludendo il jolli); giusto?

Ciao

[raimea]

ciao
si , si usa l'archio uk_49s,
si deve considerare anche il jolliy,
sono riuscuto a sistemare la macro dei migliori in --> peggiori
ecco come:

Codice: Seleziona tutto

Sub PEGGIORI_45()

userform1.Show vbModeless
DoEvents

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ultDL As Long
Dim area As Range
Dim ultB As Long
Dim riga As Long
Dim N1 As Integer
Dim N2 As Integer
Dim ambo As String
Dim t As Date
Dim cella As Range
Dim Riga2 As Long
Dim area2 As Range
Dim RitAtt As Integer
Dim tot As Integer
Dim RitMax As Integer

Set ws1 = ThisWorkbook.Sheets("Archivio_UK49s")
Set ws2 = ThisWorkbook.Sheets("ambi-ritr")
ws2.Unprotect


ultB = IIf(ws1.Range("B3").Value = "", 3, ws1.Range("B" & Rows.Count).End(xlUp).Row)

t = Now

On Error GoTo USCITA

'INSERISCO UN FOGLIO D'APPOGGIO IN CUI INSERIRò GLI AMBI INTEGRALI CHE SI
'FORMANO CON 49 NUMERI, + LE VOLTE CHE è USCITO OGNI AMBO
Set ws3 = ThisWorkbook.Sheets.Add

Set area = ws3.Range("A1:A1176")

ws3.Columns(1).NumberFormat = "@"

'CANCELLO I VALORI DELLA TABELLA DEL FOGLIO "ambi" E LA FORMATTO
With ws2.Range("DL10:DO" & Rows.Count)
    .ClearContents
    .Borders.LineStyle = xlNone
End With

'INSERISCO GLI AMBI IN ORDINE CRESCENTE NEL NUOVO FOGLIO
riga = 1
For N1 = 1 To 48
    For N2 = N1 + 1 To 49
        ws3.Cells(riga, 1).Value = N1 & "-" & N2
        riga = riga + 1
    Next N2
Next N1


For riga = 3 To ultB
    For N1 = 3 To 8
        For N2 = N1 + 1 To 9
            If ws1.Cells(riga, N1).Value < ws1.Cells(riga, N2).Value Then
                ambo = ws1.Cells(riga, N1).Value & "-" & ws1.Cells(riga, N2).Value
            Else
                ambo = ws1.Cells(riga, N2).Value & "-" & ws1.Cells(riga, N1).Value
            End If
            'CERCO L'AMBO ESTRATTO
           
            With area
                Set cella = .Find(ambo, ws3.Range("A1176"), , xlWhole)
                If Not cella Is Nothing Then
                    cella.Offset(0, 1).Value = cella.Offset(0, 1).Value + 1
                Else
                   'PROVOCO L'ERRORE IN CASO DI UN'ESTRAZIONE CON 2 NUMERI UGUALI,
                   'O ALTRA ANOMALIA
                    Err.Raise vbObjectError + 513, , _
                    "ANOMALIA NELL'ESTRAZIONE DI RIGA " & riga & vbLf & vbLf & _
                    "LA MACRO VERRA' TERMINATA", "", ContextID
                    End If
            End With
        Next N2
    Next N1
Next riga

'ORDINO LA TABELLA
ws3.Range("A1:B1176").Sort Key1:=ws3.Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

'COPIO I MIGLIORI 40
riga = 45

Do While ws3.Cells(riga + 1, 2).Value = ws3.Range("B45").Value
    riga = riga + 1
Loop

ws3.Range("A1:B" & riga).Copy ws2.Range("DL10")

'ELIMINO IL NUOVO FOGLIO
Application.DisplayAlerts = False
ws3.Delete
Application.DisplayAlerts = True


ultDL = ws2.Range("DL" & Rows.Count).End(xlUp).Row
ws2.Range("DL10:DO" & ultDL).Borders.LineStyle = xlContinuous

'=============================================================================================
'CALCOLO RITARDO ATTUALE
For riga = 10 To ultDL
   
    With ws2.Range("DL" & riga)
        N1 = Val(Mid(.Value, 1, InStr(.Value, "-")))
        N2 = Val(Mid(.Value, InStr(.Value, "-") + 1, Len(.Value)))
    End With
    For Riga2 = ultB To 3 Step -1
        Set area2 = ws1.Range("C" & Riga2, "I" & Riga2)
           
        'CERCO IL PRIMO NUMERO
        With area2
            Set cella = .Find(N1, , , xlWhole)
            If Not cella Is Nothing Then
                   
                'CERCO IL SECONDO NUMERO
                    With area2
                        Set cella = .Find(N2, , , xlWhole)
                        If Not cella Is Nothing Then
                            Exit For
                        End If
                    End With
            End If
        End With
        RitAtt = RitAtt + 1
    Next Riga2
    ws2.Range("DN" & riga).Value = RitAtt
    RitAtt = 0

Next riga


'===================================================================================================

'CALCOLO RITARDO MAX
For riga = 10 To ultDL
    With ws2.Range("DL" & riga)
        N1 = Val(Mid(.Value, 1, InStr(.Value, "-")))
        N2 = Val(Mid(.Value, InStr(.Value, "-") + 1, Len(.Value)))
    End With
        For Riga2 = ultB To 3 Step -1
        Set area2 = ws1.Range("C" & Riga2, "I" & Riga2)
           
        'CERCO IL PRIMO NUMERO
        With area2
            Set cella = .Find(N1, , , xlWhole)
            If Not cella Is Nothing Then
                   
                'CERCO IL SECONDO NUMERO
                With area2
                    Set cella = .Find(N2, , , xlWhole)
                    If Not cella Is Nothing Then
                        If tot > RitMax Then
                            RitMax = tot: tot = 0
                        Else
                            tot = 0
                        End If
                    End If
                End With
            End If
        End With
        tot = tot + 1
    Next Riga2
    ws2.Range("DO" & riga).Value = RitMax
    RitMax = 0
Next riga

'ORDINO LA TABELLA PER
' 1 - QUANTE VOLTE
' 2 - RITARDO ATTUALE

ws2.Range("DL9:DO" & Rows.Count).Sort Key1:=ws2.Range("DM10"), _
Order1:=xlAscending, Key2:=ws2.Range("DN10"), _
Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal


MsgBox Format(Now - t, "HH:MM:SS"), vbInformation, "CODICE ESEGUITO IN...."
USCITA:

If Err.Number <> 0 Then
    MsgBox Err.Description, vbCritical, "ERRORE"
    'ELIMINO IL NUOVO FOGLIO
    Application.DisplayAlerts = False
    ws3.Delete
    Application.DisplayAlerts = True
    ws1.Activate
    ws1.Range("C" & riga, "I" & riga).Activate
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ErrorCheckingOptions.TextDate = False


     '---metto data----
    ws2.Range("dj4").Value = Now  ' <<< scrivo il gg dell'ultimo aggiornmto
    ws2.Range("dj4").NumberFormat = "dddd"
    ws2.Range("dj5").Value = Now
    ws2.Range("dj5").NumberFormat = "dd/mm/yyyy"
    ws2.Range("dj6").Value = Now
    ws2.Range("dj6").NumberFormat = "HH:mm"


ActiveWindow.DisplayGridlines = False                                            'protegge il fgl
  ws2.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True

Unload userform1

Set ws1 = Nothing
Set ws2 = Nothing
Set ws3 = Nothing
Set cella = Nothing
Set area = Nothing
Set area2 = Nothing

End Sub

grazie
ciao

[Anthony47]

Hai gia' una soluzione, ma prova anche questa macro:

Codice: Seleziona tutto

Sub peggiori()
'by Anthony47 for raimea
'puo' calcolare ovviamente anche i migliori
Dim kArr(1 To 5000, 0 To 5), myVArr, WsScr As Worksheet
'Memo kArr: 0= ambo; 1=conta uscite; 2 N° ultima uscita; 3 max ritardo
Dim LastC As Long, I As Long, J As Long, myInd As Long, K As Long, cRit As Long
'
myarea = "A1:I1"    '<<< Le colonne da esaminare
'
myTim = Timer    'Uso test
'
LastC = Foglio21.Cells(Rows.Count, 3).End(xlUp).Row
Foglio21.Select
myVArr = Range(myarea).Resize(LastC).Value
'
'Calcola i dati di ogni ambo:
For I = LBound(myVArr, 1) + 2 To UBound(myVArr, 1)
    For J = LBound(myVArr, 2) + 2 To UBound(myVArr, 2) - 1
            For K = J + 1 To UBound(myVArr, 2)
                If myVArr(I, J) < myVArr(I, K) Then
                    myInd = myVArr(I, J) * 100 + myVArr(I, K)
                Else
                    myInd = myVArr(I, K) * 100 + myVArr(I, J)
                End If
                kArr(myInd, 1) = kArr(myInd, 1) + 1         'Contatore
                cRit = myVArr(I, 1) - kArr(myInd, 2) - 1    'Ritardo
                kArr(myInd, 2) = myVArr(I, 1)               'N° last Uscita
                If cRit > kArr(myInd, 3) Then kArr(myInd, 3) = cRit  'Max ritardo
                If kArr(myInd, 0) = "" Then kArr(myInd, 0) = Format(Int(myInd / 100), "00") & "_" & Format(myInd - Int(myInd / 100) * 100, "00")
            Next K
    Next J
Next I
lastcast = myVArr(UBound(myVArr, 1), 1)
'
'Calcolo ritardo corrente:
For I = LBound(kArr, 1) To UBound(kArr, 1)
    If kArr(I, 2) <> "" Then
        kArr(I, 2) = lastcast - kArr(I, 2)
    End If
Next I
'
'Elaborazione nel foglio di servizio
Set WsScr = ThisWorkbook.Sheets.Add
WsScr.Range("A1:D5000").Value = kArr()
'BLOCCO "peggiori"
With WsScr.Range("A:D")
    .Sort Key1:=.Range("B1"), Order1:=xlAscending, Key2:=.Range("A1") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
End With

Worksheets("ambi-ritr").Select
Worksheets("ambi-ritr").Unprotect
Sheets("ambi-ritr").Range("DL10").Resize(45, 4).Value = WsScr.Range("A1").Resize(45, 4).Value
     '---metto data----
    Range("dj4").Value = Now  ' <<< scrivo il gg dell'ultimo aggiornmto
    Range("dj4").NumberFormat = "dddd"
    Range("dj5").Value = Now
    Range("dj5").NumberFormat = "dd/mm/yyyy"
    Range("dj6").Value = Now
    Range("dj6").NumberFormat = "HH:mm"
ActiveWindow.DisplayGridlines = False                                            'protegge il fgl
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True

GoTo Fine        '<<*** Vedi testo
'eventuale calcolo "migliori"
With WsScr.Range("A:D")
    .Sort Key1:=.Range("B1"), Order1:=xlDescending, Key2:=.Range("A1") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
End With

Worksheets("ambi").Select
Worksheets("ambi").Unprotect
Sheets("ambi").Range("DL10").Resize(53, 4).Value = WsScr.Range("A1").Resize(53, 4).Value
     '---metto data----
    Range("dj4").Value = Now  ' <<< scrivo il gg dell'ultimo aggiornmto
    Range("dj4").NumberFormat = "dddd"
    Range("dj5").Value = Now
    Range("dj5").NumberFormat = "dd/mm/yyyy"
    Range("dj6").Value = Now
    Range("dj6").NumberFormat = "HH:mm"
ActiveWindow.DisplayGridlines = False                                            'protegge il fgl
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True

Fine:
Application.DisplayAlerts = False
WsScr.Delete
Application.DisplayAlerts = True
MsgBox (Timer - myTim)
End Sub


Rispetto alla macro che hai pubblicato e' alquanto piu' veloce.
Inoltre (vedi istruzione marcata <<***) consente di calcolare in un solo giro sia peggiori che migliori; per abilitare questa prestazione devi eliminare (o commentare) l' istruzione Goto Fine.
Spero che sia di qualche utilita'.

Ciao

[raimea]

ciao
azz e' un missile...
conferma quanto mi hai scritto e' molto piu veloce
grazie x la pazienza ad avermi fornito una 2da soluzione
ciao

[raimea]

ciao

ora che in cella DL10:DL19 ho i migliori 10 ambi nel fgl ---> ambi
tramite pulsante , vorrei riuscire a calcolare il MAX ritardo di sfaldamento,
riferito solo a questi 10 ambi, e scriverlo in DO6.

quindi: quel 'e stato il max ritardo prima che almeno uno dei 10 ambi uscisse.
naturalmente gli ambi sono da cercare nel fgl archivio_uk49

vi allego il file:

https://db.tt/5GJ6TCzs

grazie

[Anthony47]

Non ho nessuna idea di che cosa sia lo sfaldamento; ma mi confermi che la richiesta sia quella specificata nelle seconda parte del messaggio, cioe' calcolare "il max ritardo prima che almeno uno dei 10 ambi uscisse"?
Se e' cosi', un eventuale ambo mai uscito (mai uscito prima) va ignorato, vero?

Ciao

[raimea]

ciao

calcolare "il max ritardo prima che almeno uno dei 10 ambi uscisse"?

esatto , confermo

un eventuale ambo mai uscito (mai uscito prima) va ignorato, vero?

esatto, confermo

vanno considerati solo i 10 ambi in DL10:DL19

grazie ciao

[Anthony47]

Premetto che la definizione del problema mi sembra ambigua (me ne sono accorto solo quando sono passato allo studio dell' algoritmo da usare... Questa macro riporta quale e' il max ritardo o ritardo corrente nel momento in cui esce per la prima volta un top ten:

Codice: Seleziona tutto

Sub MaxDel()
'by Anthony47 for raimea
'calcola il max ritardo quando esce il primo tra i top 10
Dim kArr(1 To 5000, 0 To 5), myVArr, WsScr As Worksheet, myBArea As Range, myMatch, myMaxD
'Memo kArr: 0= ambo; 1=conta uscite; 2 N° ultima uscita; 3 max ritardo
Dim LastC As Long, I As Long, J As Long, myInd As Long, K As Long, cRit As Long, myCMax As Long
'
myarea = "A1:I1"    '<<< Le colonne da esaminare
'
myTim = Timer    'Uso test
'
LastC = Foglio21.Cells(Rows.Count, 3).End(xlUp).Row
Foglio21.Select
myVArr = Range(myarea).Resize(LastC).Value
'
Set myBArea = Foglio11.Range("DL10:DL19")
'
'Calcola i dati di ogni ambo:
For I = LBound(myVArr, 1) + 2 To UBound(myVArr, 1)
    For J = LBound(myVArr, 2) + 2 To UBound(myVArr, 2) - 1
            For K = J + 1 To UBound(myVArr, 2)
                If myVArr(I, J) < myVArr(I, K) Then
                    myInd = myVArr(I, J) * 100 + myVArr(I, K)
                Else
                    myInd = myVArr(I, K) * 100 + myVArr(I, J)
                End If
                kArr(myInd, 1) = kArr(myInd, 1) + 1         'Contatore
                cRit = myVArr(I, 1) - kArr(myInd, 2) - 1    'Ritardo
                kArr(myInd, 2) = myVArr(I, 1)               'N° last Uscita
                If cRit > kArr(myInd, 3) Then kArr(myInd, 3) = cRit  'Max ritardo
                If kArr(myInd, 0) = "" Then kArr(myInd, 0) = Format(Int(myInd / 100), "00") & "_" & Format(myInd - Int(myInd / 100) * 100, "00")
            Next K
           
myMatch = Application.Match(Format(Int(myInd / 100), "00") & "_" & Format(myInd - Int(myInd / 100) * 100, "00"), myBArea, 0)
If Not IsError(myMatch) Then GoTo Trovato   '>>>>>>>>>>>>
    Next J
Next I

Trovato:
lastcast = myVArr(I, 1)
Debug.Print I
'Debug.Print myInd

'
'Calcolo ritardo corrente:
For I = LBound(kArr, 1) To UBound(kArr, 1)
    If kArr(I, 2) <> "" Then kArr(I, 2) = lastcast - kArr(I, 2)
    If kArr(I, 3) < (lastcast - kArr(I, 2)) Then kArr(I, 3) = (lastcast - kArr(I, 2))
Next I

myMaxD = Application.WorksheetFunction.Index(kArr(), 0, 3)
myCMax = Application.WorksheetFunction.Max(myMaxD)
Debug.Print myInd & " - " & lastcast & " - " & Application.Match(myCMax, myMaxD, 0) _
    & " - " & kArr(Application.Match(myCMax, myMaxD, 0), 0) & " - "; myCMax

MsgBox ("Max ritardo: " & myCMax & vbCrLf & _
    myInd & " - " & lastcast & " - " & Application.Match(myCMax, myMaxD, 0) _
    & " - " & kArr(Application.Match(myCMax, myMaxD, 0), 0) & " - " & myCMax & _
    vbCrLf & "Timer: " & Format(Timer - myTim, "0.000"))
   
'Stop

End Sub


Come vedi la prima parte e' simile alla Sub Peggiori, la seconda e' specifica per il problema posto.
Il risultato viene presentato in un msgbox (prima informazione), ma e' calcolata nella variabile myCMax per eventualmente inserirla in cella.
Ho detto che viene calcolato "quale e' il max ritardo o ritardo corrente"; intendo dire che se un ambo e' gia' uscito con mettiamo ritardo 10 e il suo ritardo corrente e' 5 allora io riporto 10 (nell' ipotesi che nessun ambo abbia un ritardo corrente o un ritardo max superiore a 10).
Ho anche l' impressione che il dato calcolato sia sistematicamente pari al numero di estrazione in cui e' capitato il primo dei top ten, ma non capendo granche' di questi giochi (di cui comunque conosco la regola di fondo: statisticamente il banco batte il giocatore 2 a 1) mi sono cimentato lo stesso.

Ciao.

[raimea]

ciao

conosco la regola di fondo: statisticamente il banco batte il giocatore 2 a 1

su questo non ci sono dubbi , cio che si fa e' riuscire almeno a pareggiare,
e magari andare in vantaggio per un po di tempo

sulla macro Sub MaxDel()
faccio fatica a capire il risultato:


in questo caso sembrerebbe che sia l'ambo 1_13 il piu in ritardo ?
ma 1_13 non fa parte del gruppo dei 10.

prova a descrive cio che cerco con un esempio con dati casuali.

dall'estrazione 6001 del 1.9.13 all'estraz 6050 del 25.9.13 non c'e stato nessun ambo tra i 10 analizzati
dall'estraz 6001 a 6050 ci sono state quindi 49 estraz con nessun ambo fra i 10
49 e' il MAX ritardo che sto cercando, perche non c'e stato nessuno degli ambi DL10:dl19

grazie
ciao

[Anthony47]

mi confermi che la richiesta sia quella specificata nelle seconda parte del messaggio, cioe' calcolare "il max ritardo prima che almeno uno dei 10 ambi uscisse"?

esatto , confermo

Premetto che la definizione del problema mi sembra ambigua (me ne sono accorto solo quando sono passato allo studio dell' algoritmo da usare... Questa macro riporta quale e' il max ritardo o ritardo corrente nel momento in cui esce per la prima volta un top ten

in questo caso sembrerebbe che sia l'ambo 1_13 il piu in ritardo ?
ma 1_13 non fa parte del gruppo dei 10

c.v.d.

Nella mia interpretazione si parte dalla prima estrazione e si fotografa la situazione appena esce il primo ambo (in ordine di tempo, non di classifica) presente nell' elenco dei top ten (cosa che succede nell' estrazione 7, 47/48). In quel momento il max ritardo era (prevedibilmente) 6, da riferire agli ambi contenuti nella prima riga, di cui 1_13 e' il primo).

Dal supplemento di descrizione mi pare invece che tu voglia una cosa piu' articolata; cioe' ripercorrere le estrazioni, ogni volta che esce uno dei top ten calcolare il max dei ritardi corrente dei rimanenti top 9 e alla fine del giro indicare il max dei max.

Confermi?

Ciao

[raimea]

esatto
il max dei maximi,
cioe:
quant' e' il num di estrazioni maxime in cui non c' e' nemmeno uno dei 10 ambi ?

io con numeri casuali ho simulato di analizzare tutto l'archivio,
e aver trovato un perido di 49 estrazioni in cui non vine estratto nemmeno uno dei 10 ambi.

io sto cercando di trovare questo "49" come se fosse il maximo.
ciao

[Anthony47]

No, questi argomenti mi fanno proprio rallentare i neuroni...
Ma tu vuoi calcolare (a) il ritardo tra un top-10 e il successivo (qualsiasi altro) top-10, e alla fine il max tra questi ritardi; o (b) il max ritardo che gli altri 9 top-10 hanno al momento dell' estrazione di un top-10 e alla fine il max tra questi ritardi?
Il tuo esempio suggerisce che cerchi il calcolo (a), che corrisponde alla semplice differenza tra l' estrazione corrente e l' estrazione precedente di un top-10, su cui alla fine calcolare il max; quello che io ti avevo chiesto di confermare invece e' l' ipotesi (b), che implica il corretto e completo calcolo dei ritardi, da cui prendere il max tra i 9 non estratti e alla fine prendere il max tra i max...

Insomma, necessario supplemento al supplemento di chiarimenti.

Ciao

[raimea]

ciao
cerco il caso A

(a) il ritardo tra un top-10 e il successivo (qualsiasi altro) top-10, e alla fine il max tra questi ritardi

cosi esposta sembra piu chiaro
grazie x la pazienza

[Anthony47]

Penultimo tentativo:

Codice: Seleziona tutto

Sub MaxDel_V01()
'by Anthony47 for raimea
'calcola il ritardo dei top 10, poi il max dei ritardi
'(max ritardo corrente tra un top-10 e l' altro; poi il max dei max
Dim myVArr, myTim As Single, myBArea As Range, myMaxD, myArea
Dim LastC As Long, I As Long, J As Long, myInd As Long, K As Long, cRit As Long, myCMax As Long
Dim preAmbo As String, cAmbo As String, PreEstr As Long, preEstr0 As Long
'
myArea = "A1:I1"    '<<< Le colonne da esaminare
'
myTim = Timer    'Uso test
'
LastC = Foglio21.Cells(Rows.Count, 3).End(xlUp).Row
Foglio21.Select
myVArr = Range(myArea).Resize(LastC).Value
'

Set myBArea = Foglio11.Range("DL10:DL19")   'I top 10

PreEstr = 0

'Calcola i dati di ogni ambo:
For I = LBound(myVArr, 1) + 2 To UBound(myVArr, 1)
    For J = LBound(myVArr, 2) + 2 To UBound(myVArr, 2) - 1
            For K = J + 1 To UBound(myVArr, 2)
                If myVArr(I, J) < myVArr(I, K) Then
                    myInd = myVArr(I, J) * 100 + myVArr(I, K)
                Else
                    myInd = myVArr(I, K) * 100 + myVArr(I, J)
                End If
'esamina solo i top ten:
                If Application.WorksheetFunction.CountIf(myBArea, Format(Int(myInd / 100), "00") & _
                        "_" & Format(myInd - Int(myInd / 100) * 100, "00")) > 0 Or I = UBound(myVArr, 1) Then
                    cRit = myVArr(I, 1) - PreEstr - 1
                    preEstr0 = PreEstr: PreEstr = myVArr(I, 1)
                    preAmbo = cAmbo
                   
                    If cRit > myMaxD Then
                        myMaxD = cRit
                        If I = UBound(myVArr, 1) Then
                            cAmbo = "" & "--" & I
                        Else
                            cAmbo = Format(Int(myInd / 100), "00") & "_" & Format(myInd - Int(myInd / 100) * 100, "00") & "--" & myVArr(I, LBound(myVArr, 2))
                        End If
                    End If
               
                End If
            Next K
    Next J
Next I

'Stop
'
MsgBox ("Max ritardo: " & myMaxD & vbCrLf & _
     cAmbo & vbCrLf & _
    "Timer: " & Format(Timer - myTim, "0.000"))
'
End Sub

Il valore e' nella variabile myMaxD, pronto per essere caricato nella tua cella preferita.

Ciao

[raimea]

ciao
ok , mi sa che ci siamo,
dammi solo l'ultimo aiuto / conferma a leggere il risultato:



alla estraz num 2740 c'e stato l'ambo 12_35
e le 31 estraz precedenti non contengono nessun tra i 10 ambi top
giusto?
grazie ciao

[Anthony47]

Confermo la lettura del msgbox: max ritardo 31, ottenuto sull' ambo 12-35 dell' estrazione 2740, col precedente ambo in estrazione 2740-31.
Se devi caricare il valore calcolato del max ritardo in una cella, il suo valore e' nella variabile myMaxD; quindi userai

Codice: Seleziona tutto

Sheets("IlFoglio").range("LaCella").value =myMaxD


Ciao

[raimea]

ciao
tutto ok
grazie antony