Novità

Script che non va..chi puo guardarlo?

adispo2000

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
 
adispo2000 ha scritto:
scusa che tipo di ambiente VBA ha Spaziometria? In modo da poterlo convertire
Clicca per espandere...
Spaziometria ha ambiente spazioscript, esso usa il linguaggio VBscript implementato con immumerevoli funzioni per il lotto e giochi vari.
Lo script contiene :
Dim UltimaEst As Integer dichiarazione tipica di vba excel

For Y = 1 To 90
nFr01(Y - 1,0) = Y
nFr01(Y - 1,1) = EstrattoFrequenzaDL(Y,Ini,Fin)
Next Y tipico di vba di excel

Che sia Twin basic o altro non saprei sicuramente è scritto per il lotto da questo forum
 
Codice: 
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
          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
          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
          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,Num2)
     Dim UltimaEst : UltimaEst = EstrazioneFinDL()
     Dim InizioEst : InizioEst = UltimaEst - 49
     Dim Terni(88, 3)
     Dim Frequenze(88)
     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
     ' 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
     Next
     ' 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
     Next
     ' Mostra i 10 terni più "mancati"
     Dim msg
          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
     MsgBox msg
End Sub
Function Format2(ByVal N )
     Format2 = Format(N,"00")
End Function
Function InArray(Valore,Arr)
     Dim i
     For i = LBound(Arr) To UBound(Arr)
          If Arr(i) = Valore Then
               InArray = True
               Exit Function
          End If
     Next
     InArray = False
End Function

Non è ancora funzionante lo lascio qui per darvi la possibilità di completare le correzioni.
 
claudio8 ha scritto:
Codice: 
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
          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
          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
          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,Num2)
     Dim UltimaEst : UltimaEst = EstrazioneFinDL()
     Dim InizioEst : InizioEst = UltimaEst - 49
     Dim Terni(88, 3)
     Dim Frequenze(88)
     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
     ' 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
     Next
     ' 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
     Next
     ' Mostra i 10 terni più "mancati"
     Dim msg
          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
     MsgBox msg
End Sub
Function Format2(ByVal N )
     Format2 = Format(N,"00")
End Function
Function InArray(Valore,Arr)
     Dim i
     For i = LBound(Arr) To UBound(Arr)
          If Arr(i) = Valore Then
               InArray = True
               Exit Function
          End If
     Next
     InArray = False
End Function

Non è ancora funzionante lo lascio qui per darvi la possibilità di completare le correzioni.
Clicca per espandere...
prima parte l'ho modificata cosi:
Dim Tipoarchivio : Tipoarchivio = ScegliArchivioDL()
If Tipoarchivio > 00 Then
If Tipoarchivio = 02 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)
Mi restituisce Errore 500 - variabile non definita ScegliArchivioDL() linea 3 colonna 25:(:(:(:(
 
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    giovedì 31 luglio 2025
    Bari
    42
    35
    89
    51
    34
    Cagliari
    54
    34
    02
    77
    57
    Firenze
    73
    01
    07
    15
    04
    Genova
    71
    28
    17
    03
    67
    Milano
    72
    37
    26
    09
    63
    Napoli
    04
    46
    83
    68
    31
    Palermo
    62
    18
    36
    34
    52
    Roma
    37
    44
    49
    67
    32
    Torino
    51
    17
    56
    48
    41
    Venezia
    36
    04
    85
    81
    41
    Nazionale
    08
    52
    01
    24
    05
    Estrazione Simbolotto
    Nazionale
    21
    19
    01
    17
    43
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto