adispo2000
Super Member >PLATINUM<
Ciao a tutti come da oggetto chi puo verificarlo?
Sub Main()
Dim Tipoarchivio: Tipoarchivio = ScegliArchivioDL()
If Tipoarchivio > 0 Then
If Tipoarchivio = 2 Then
If MsgBox("Vuoi aggiornare le estrazioni prima di eseguire il listato?", vbQuestion + vbYesNo) = vbYes Then
Call AggiornaArchivioDL()
End If
End If
Call ImpostaArchivio10ELotto(Tipoarchivio)
' === ANALISI 10 NUMERI PIÙ FREQUENTI SU 4 ESTRAZIONI ===
Dim EstrCon: EstrCon = 4 ' fisse 4 estrazioni
Dim Ini, Fin: Ini = EstrazioneFinDL - EstrCon + 1: Fin = EstrazioneFinDL
Dim Y
Dim nFr01(90, 1)
For Y = 1 To 90
nFr01(Y - 1, 0) = Y
nFr01(Y - 1, 1) = EstrattoFrequenzaDL(Y, Ini, Fin)
Next Y
Call OrdinaMatriceTurbo(nFr01, -1, 1) ' ordina per frequenza decrescente
Dim EN(10)
For Y = 1 To 10
EN(Y) = Format2(nFr01(Y - 1, 0))
Next Y
Dim aNumeri
aNumeri = Array(EN(1), EN(2), EN(3), EN(4), EN(5), EN(6), EN(7), EN(8), EN(9), EN(10))
Call Scrivi("Top 10 numeri più frequenti nelle ultime 4 estrazioni: " & StringaNumeri(aNumeri))
' === INPUT UTENTE: 2 NUMERI ===
Dim Num1, Num2 As Integer
Num1 = CInt(InputBox("Inserisci il primo numero (1-90)", "Numero 1"))
Num2 = CInt(InputBox("Inserisci il secondo numero (1-90)", "Numero 2"))
If Num1 = Num2 Or Num1 < 1 Or Num1 > 90 Or Num2 < 1 Or Num2 > 90 Then
MsgBox "Numeri non validi o uguali. Esco."
Exit Sub
End If
' === ANALISI TERNI MANCATI ===
Call AnalizzaTerniMancati(Num1, Num2)
End If
End Sub
Sub AnalizzaTerniMancati(Num1 As Integer, Num2 As Integer)
Dim UltimaEst As Integer: UltimaEst = EstrazioneFinDL()
Dim InizioEst As Integer: InizioEst = UltimaEst - 49
Dim Terni(1 To 88, 1 To 3)
Dim Frequenze(1 To 88) As Integer
Dim terzo, idx, EID, i
idx = 1
For terzo = 1 To 90
If terzo <> Num1 And terzo <> Num2 Then
Terni(idx, 1) = Num1
Terni(idx, 2) = Num2
Terni(idx, 3) = terzo
Frequenze(idx) = 0
idx = idx + 1
End If
Next terzo
' Conta le assenze
Dim estrazione, t
For i = 1 To 88
For EID = InizioEst To UltimaEst
estrazione = EstrazioneNumeriDL(EID)
If Not (InArray(Terni(i, 1), estrazione) And InArray(Terni(i, 2), estrazione) And InArray(Terni(i, 3), estrazione)) Then
Frequenze(i) = Frequenze(i) + 1
End If
Next EID
Next i
' Ordina i terni per numero di assenze
Dim j, tmpFreq, tmp1, tmp2, tmp3
For i = 1 To 87
For j = i + 1 To 88
If Frequenze(i) < Frequenze(j) Then
tmpFreq = Frequenze(i)
Frequenze(i) = Frequenze(j)
Frequenze(j) = tmpFreq
tmp1 = Terni(i, 1): tmp2 = Terni(i, 2): tmp3 = Terni(i, 3)
Terni(i, 1) = Terni(j, 1): Terni(i, 2) = Terni(j, 2): Terni(i, 3) = Terni(j, 3)
Terni(j, 1) = tmp1: Terni(j, 2) = tmp2: Terni(j, 3) = tmp3
End If
Next j
Next i
' Mostra i 10 terni più "mancati"
Dim msg As String
msg = "10 terni più mancati contenenti " & Format2(Num1) & " e " & Format2(Num2) & ":" & vbCrLf & vbCrLf
For i = 1 To 10
msg = msg & Format2(Terni(i, 1)) & " - " & Format2(Terni(i, 2)) & " - " & Format2(Terni(i, 3)) & _
" | Mancato in " & Frequenze(i) & " su 50 estrazioni" & vbCrLf
Next i
MsgBox msg
End Sub
Function Format2(ByVal N As Integer) As String
Format2 = Format(N, "00")
End Function
Function InArray(Valore, Arr) As Boolean
Dim i
For i = LBound(Arr) To UBound(Arr)
If Arr(i) = Valore Then
InArray = True
Exit Function
End If
Next i
InArray = False
End Function
Sub Main()
Dim Tipoarchivio: Tipoarchivio = ScegliArchivioDL()
If Tipoarchivio > 0 Then
If Tipoarchivio = 2 Then
If MsgBox("Vuoi aggiornare le estrazioni prima di eseguire il listato?", vbQuestion + vbYesNo) = vbYes Then
Call AggiornaArchivioDL()
End If
End If
Call ImpostaArchivio10ELotto(Tipoarchivio)
' === ANALISI 10 NUMERI PIÙ FREQUENTI SU 4 ESTRAZIONI ===
Dim EstrCon: EstrCon = 4 ' fisse 4 estrazioni
Dim Ini, Fin: Ini = EstrazioneFinDL - EstrCon + 1: Fin = EstrazioneFinDL
Dim Y
Dim nFr01(90, 1)
For Y = 1 To 90
nFr01(Y - 1, 0) = Y
nFr01(Y - 1, 1) = EstrattoFrequenzaDL(Y, Ini, Fin)
Next Y
Call OrdinaMatriceTurbo(nFr01, -1, 1) ' ordina per frequenza decrescente
Dim EN(10)
For Y = 1 To 10
EN(Y) = Format2(nFr01(Y - 1, 0))
Next Y
Dim aNumeri
aNumeri = Array(EN(1), EN(2), EN(3), EN(4), EN(5), EN(6), EN(7), EN(8), EN(9), EN(10))
Call Scrivi("Top 10 numeri più frequenti nelle ultime 4 estrazioni: " & StringaNumeri(aNumeri))
' === INPUT UTENTE: 2 NUMERI ===
Dim Num1, Num2 As Integer
Num1 = CInt(InputBox("Inserisci il primo numero (1-90)", "Numero 1"))
Num2 = CInt(InputBox("Inserisci il secondo numero (1-90)", "Numero 2"))
If Num1 = Num2 Or Num1 < 1 Or Num1 > 90 Or Num2 < 1 Or Num2 > 90 Then
MsgBox "Numeri non validi o uguali. Esco."
Exit Sub
End If
' === ANALISI TERNI MANCATI ===
Call AnalizzaTerniMancati(Num1, Num2)
End If
End Sub
Sub AnalizzaTerniMancati(Num1 As Integer, Num2 As Integer)
Dim UltimaEst As Integer: UltimaEst = EstrazioneFinDL()
Dim InizioEst As Integer: InizioEst = UltimaEst - 49
Dim Terni(1 To 88, 1 To 3)
Dim Frequenze(1 To 88) As Integer
Dim terzo, idx, EID, i
idx = 1
For terzo = 1 To 90
If terzo <> Num1 And terzo <> Num2 Then
Terni(idx, 1) = Num1
Terni(idx, 2) = Num2
Terni(idx, 3) = terzo
Frequenze(idx) = 0
idx = idx + 1
End If
Next terzo
' Conta le assenze
Dim estrazione, t
For i = 1 To 88
For EID = InizioEst To UltimaEst
estrazione = EstrazioneNumeriDL(EID)
If Not (InArray(Terni(i, 1), estrazione) And InArray(Terni(i, 2), estrazione) And InArray(Terni(i, 3), estrazione)) Then
Frequenze(i) = Frequenze(i) + 1
End If
Next EID
Next i
' Ordina i terni per numero di assenze
Dim j, tmpFreq, tmp1, tmp2, tmp3
For i = 1 To 87
For j = i + 1 To 88
If Frequenze(i) < Frequenze(j) Then
tmpFreq = Frequenze(i)
Frequenze(i) = Frequenze(j)
Frequenze(j) = tmpFreq
tmp1 = Terni(i, 1): tmp2 = Terni(i, 2): tmp3 = Terni(i, 3)
Terni(i, 1) = Terni(j, 1): Terni(i, 2) = Terni(j, 2): Terni(i, 3) = Terni(j, 3)
Terni(j, 1) = tmp1: Terni(j, 2) = tmp2: Terni(j, 3) = tmp3
End If
Next j
Next i
' Mostra i 10 terni più "mancati"
Dim msg As String
msg = "10 terni più mancati contenenti " & Format2(Num1) & " e " & Format2(Num2) & ":" & vbCrLf & vbCrLf
For i = 1 To 10
msg = msg & Format2(Terni(i, 1)) & " - " & Format2(Terni(i, 2)) & " - " & Format2(Terni(i, 3)) & _
" | Mancato in " & Frequenze(i) & " su 50 estrazioni" & vbCrLf
Next i
MsgBox msg
End Sub
Function Format2(ByVal N As Integer) As String
Format2 = Format(N, "00")
End Function
Function InArray(Valore, Arr) As Boolean
Dim i
For i = LBound(Arr) To UBound(Arr)
If Arr(i) = Valore Then
InArray = True
Exit Function
End If
Next i
InArray = False
End Function