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
    martedì 02 settembre 2025
    Bari
    36
    17
    23
    80
    83
    Cagliari
    06
    17
    77
    59
    86
    Firenze
    74
    11
    43
    64
    62
    Genova
    43
    31
    55
    05
    78
    Milano
    86
    04
    34
    45
    59
    Napoli
    18
    69
    05
    30
    26
    Palermo
    20
    09
    76
    80
    55
    Roma
    89
    26
    57
    75
    46
    Torino
    17
    74
    35
    12
    54
    Venezia
    18
    34
    19
    40
    66
    Nazionale
    49
    14
    32
    19
    07
    Estrazione Simbolotto
    Palermo
    13
    19
    29
    01
    33
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto