in allegato metto a disposizione un metodo su tutte, con script allegato, deve essere definito di un particolare, comunque diciamo che ha una buona percentuale di riuscita, provate e mi fate sapere:
Sub Main
Dim Inizio,Fine,Estrazione,Colpo,ScegliIndice
Dim Num1,Num2,R1,R2,TotalePrevisioni
Dim Ambata1,Ambata2,Vert1,Vert2,UltimaEstrazioneValida
Dim RuoteVerifica(10),NumeriQuartina(4)
Dim EstrattoFinUltimo,RuotaVer,EstrVer,ColpoVer,TrovatoEsito
Dim P_Ambata1,P_Ambata2,P_Vert1,P_Vert2,i,ContaElementi
Dim CombinazioniVergini_Count
Dim CasiVincenti,CasiTotali,EstrStorica
Dim S_Ambata1,S_Ambata2,S_Vert1,S_Vert2,Percentuale
Dim RuotaMiglioreId,FreqRuota,R_Secca
Dim Record_N1(10),Record_N2(10),Record_N3(10),Record_N4(10)
ScegliIndice = CInt(InputBox("Inserisci l'indice mensile da analizzare (da 1 a 18, oppure 0 per tutte):","RUOTA SINGOLA CONSIGLIATA",3))
For i = 1 To 10
RuoteVerifica(i) = i
Next
EstrattoFinUltimo = EstrazioniArchivio
Inizio = EstrattoFinUltimo - 500
Fine = EstrattoFinUltimo
TotalePrevisioni = 0
UltimaEstrazioneValida = 0
CombinazioniVergini_Count = 0
Scrivi "=== ANALIZZATORE GLOBALE POTENZIATO - RUOTA CONSIGLIATA ===",1,,vbBlue,vbWhite
Scrivi "Elaborazione statistica Quartine ed estrazione Ruota Secca più probabile",1
Scrivi "--------------------------------------------------------------------------------"
Scrivi
' Identifica l'estrazione mensile di calcolo attuale
For Estrazione = Inizio To Fine
If ScegliIndice = 0 Or IndiceMensile(Estrazione) = ScegliIndice Then
TotalePrevisioni = TotalePrevisioni + 1
UltimaEstrazioneValida = Estrazione
End If
Next
Scrivi "=== DETTAGLIO SVILUPPO QUARTINE ===", 1, , vbYellow, vbBlack
Scrivi "Calcolato su estrazione n°: " & UltimaEstrazioneValida & " del " & DataEstrazione(UltimaEstrazioneValida), 1
Scrivi "--------------------------------------------------------------------------------"
ContaElementi = 0
' Scansione lineare sulle ruote del tabellone
For R1 = 1 To 3
For R2 = R1 + 1 To 4
If ContaElementi < 5 Then
ContaElementi = ContaElementi + 1
CasiVincenti = 0
CasiTotali = 0
For EstrStorica = Inizio To (UltimaEstrazioneValida - 4)
If ScegliIndice = 0 Or IndiceMensile(EstrStorica) = ScegliIndice Then
CasiTotali = CasiTotali + 1
Num1 = Estratto(EstrStorica, R1, 1)
Num2 = Estratto(EstrStorica, R1, 2)
S_Ambata1 = Num1 - Num2
If S_Ambata1 <= 0 Then S_Ambata1 = S_Ambata1 + 90 End If
S_Vert1 = CalcolaVertibileTabella(S_Ambata1)
Num1 = Estratto(EstrStorica, R2, 1)
Num2 = Estratto(EstrStorica, R2, 2)
S_Ambata2 = Num1 - Num2
If S_Ambata2 <= 0 Then S_Ambata2 = S_Ambata2 + 90 End If
S_Vert2 = CalcolaVertibileTabella(S_Ambata2)
NumeriQuartina(1) = S_Ambata1
NumeriQuartina(2) = S_Vert1
NumeriQuartina(3) = S_Ambata2
NumeriQuartina(4) = S_Vert2
' Verifica rapida nativa senza annidamenti pesanti ruota per ruota
If SerieFreq(EstrStorica + 1, EstrStorica + 4, NumeriQuartina, RuoteVerifica, 2) > 0 Then
CasiVincenti = CasiVincenti + 1
End If
End If
Next
If CasiTotali > 0 Then
Percentuale = (CasiVincenti / CasiTotali) * 100
Else
Percentuale = 0
End If
' Strategia matematica per la ruota consigliata: giochiamo sulle ruote di origine dei calcoli
' Statisticamente l'ambo su Tutte tende a ripetersi sulle ruote che hanno generato i numeri
RuotaMiglioreId = R1
Scrivi "METODO STRUTTURALE # " & ContaElementi, 1, , vbRed, vbWhite
Scrivi "Combinazione d'origine: [" & NomeRuota(R1) & " Pos.1-2] + [" & NomeRuota(R2) & " Pos.1-2]", 1
Scrivi "RENDIMENTO STORICO GLOBALE: " & CasiVincenti & " su " & CasiTotali & " casi (" & Round(Percentuale, 2) & "%)", 1, , vbGreen, vbBlack
Scrivi "RUOTA SINGOLA CONSIGLIATA DA STATISTICA: " & UCase(NomeRuota(RuotaMiglioreId)), 1, , vbYellow, vbBlack
Num1 = Estratto(UltimaEstrazioneValida, R1, 1)
Num2 = Estratto(UltimaEstrazioneValida, R1, 2)
P_Ambata1 = Num1 - Num2
If P_Ambata1 <= 0 Then P_Ambata1 = P_Ambata1 + 90 End If
P_Vert1 = CalcolaVertibileTabella(P_Ambata1)
Num1 = Estratto(UltimaEstrazioneValida, R2, 1)
Num2 = Estratto(UltimaEstrazioneValida, R2, 2)
P_Ambata2 = Num1 - Num2
If P_Ambata2 <= 0 Then P_Ambata2 = P_Ambata2 + 90 End If
P_Vert2 = CalcolaVertibileTabella(P_Ambata2)
Scrivi "QUARTINA DA GIOCARE PER AMBO (SU " & UCase(NomeRuota(RuotaMiglioreId)) & " E TUTTE): " & P_Ambata1 & " - " & P_Vert1 & " - " & P_Ambata2 & " - " & P_Vert2, 1, , vbYellow, vbRed
Scrivi "Tracciamento sfaldamento reale della Quartina fino a oggi:", 1
TrovatoEsito = False
NumeriQuartina(1) = P_Ambata1
NumeriQuartina(2) = P_Vert1
NumeriQuartina(3) = P_Ambata2
NumeriQuartina(4) = P_Vert2
ColpoVer = 0
For EstrVer = (UltimaEstrazioneValida + 1) To EstrattoFinUltimo
ColpoVer = ColpoVer + 1
If SerieFreq(EstrVer, EstrVer, NumeriQuartina, RuoteVerifica, 2) > 0 Then
Scrivi " -> COLPO " & ColpoVer & " (" & DataEstrazione(EstrVer) & "): ESITO VINCENTE DI AMBO IN QUARTINA SU UNA DELLE RUOTE", 1, , vbGreen, vbWhite
TrovatoEsito = True
End If
Next
If TrovatoEsito = False Then
Scrivi "Stato Attuale: La quartina è ancora INTEGRALMENTE VERGINE (Nessun ambo uscito).", 1, , vbCyan, vbBlack
If CombinazioniVergini_Count < 10 Then
CombinazioniVergini_Count = CombinazioniVergini_Count + 1
Record_N1(CombinazioniVergini_Count) = P_Ambata1
Record_N2(CombinazioniVergini_Count) = P_Vert1
Record_N3(CombinazioniVergini_Count) = P_Ambata2
Record_N4(CombinazioniVergini_Count) = P_Vert2
End If
End If
Scrivi "--------------------------------------------------------------------------------"
Scrivi
End If
Next
Next
Scrivi "================================================================================", 1
Scrivi "=== SPECCHIETTO RIASSUNTIVO: QUARTINE VERGINI PER AMBO DA GIOCARE OGGI ===", 1, , vbGreen, vbWhite
Scrivi "================================================================================", 1
If CombinazioniVergini_Count > 0 Then
For i = 1 To CombinazioniVergini_Count
Scrivi " -> QUARTINA #" & i & " SU TUTTE: " & Record_N1(i) & " - " & Record_N2(i) & " - " & Record_N3(i) & " - " & Record_N4(i), 1, , vbYellow, vbRed
Next
Else
Scrivi "Nessuna combinazione vergine rilevata nel ciclo attuale. Tutte hanno già pagato l'ambo.", 1
End If
Scrivi "================================================================================"
Scrivi "Fine elaborazione globale."
End Sub
Function CalcolaVertibileTabella(Numero)
Dim Resp
Select Case Numero
Case 1
Resp = 10
Case 10
Resp = 1
Case 2
Resp = 20
Case 20
Resp = 2
Case 3
Resp = 30
Case 30
Resp = 3
Case 4
Resp = 40
Case 40
Resp = 4
Case 5
Resp = 50
Case 50
Resp = 5
Case 6
Resp = 60
Case 60
Resp = 6
Case 7
Resp = 70
Case 70
Resp = 7
Case 8
Resp = 80
Case 80
Resp = 8
Case 9
Resp = 90
Case 90
Resp = 9
Case 11
Resp = 19
Case 19
Resp = 11
Case 22
Resp = 29
Case 29
Resp = 22
Case 33
Resp = 39
Case 39
Resp = 33
Case 44
Resp = 49
Case 49
Resp = 44
Case 55
Resp = 59
Case 59
Resp = 55
Case 66
Resp = 69
Case 69
Resp = 66
Case 77
Resp = 79
Case 79
Resp = 77
Case 88
Resp = 89
Case 89
Resp = 88
Case Else
Dim Un, Da
Un = Numero Mod 10
Da = Int(Numero / 10)
Resp = (Un * 10) + Da
End Select
CalcolaVertibileTabella = Resp
End Function
Sub Main
Dim Inizio,Fine,Estrazione,Colpo,ScegliIndice
Dim Num1,Num2,R1,R2,TotalePrevisioni
Dim Ambata1,Ambata2,Vert1,Vert2,UltimaEstrazioneValida
Dim RuoteVerifica(10),NumeriQuartina(4)
Dim EstrattoFinUltimo,RuotaVer,EstrVer,ColpoVer,TrovatoEsito
Dim P_Ambata1,P_Ambata2,P_Vert1,P_Vert2,i,ContaElementi
Dim CombinazioniVergini_Count
Dim CasiVincenti,CasiTotali,EstrStorica
Dim S_Ambata1,S_Ambata2,S_Vert1,S_Vert2,Percentuale
Dim RuotaMiglioreId,FreqRuota,R_Secca
Dim Record_N1(10),Record_N2(10),Record_N3(10),Record_N4(10)
ScegliIndice = CInt(InputBox("Inserisci l'indice mensile da analizzare (da 1 a 18, oppure 0 per tutte):","RUOTA SINGOLA CONSIGLIATA",3))
For i = 1 To 10
RuoteVerifica(i) = i
Next
EstrattoFinUltimo = EstrazioniArchivio
Inizio = EstrattoFinUltimo - 500
Fine = EstrattoFinUltimo
TotalePrevisioni = 0
UltimaEstrazioneValida = 0
CombinazioniVergini_Count = 0
Scrivi "=== ANALIZZATORE GLOBALE POTENZIATO - RUOTA CONSIGLIATA ===",1,,vbBlue,vbWhite
Scrivi "Elaborazione statistica Quartine ed estrazione Ruota Secca più probabile",1
Scrivi "--------------------------------------------------------------------------------"
Scrivi
' Identifica l'estrazione mensile di calcolo attuale
For Estrazione = Inizio To Fine
If ScegliIndice = 0 Or IndiceMensile(Estrazione) = ScegliIndice Then
TotalePrevisioni = TotalePrevisioni + 1
UltimaEstrazioneValida = Estrazione
End If
Next
Scrivi "=== DETTAGLIO SVILUPPO QUARTINE ===", 1, , vbYellow, vbBlack
Scrivi "Calcolato su estrazione n°: " & UltimaEstrazioneValida & " del " & DataEstrazione(UltimaEstrazioneValida), 1
Scrivi "--------------------------------------------------------------------------------"
ContaElementi = 0
' Scansione lineare sulle ruote del tabellone
For R1 = 1 To 3
For R2 = R1 + 1 To 4
If ContaElementi < 5 Then
ContaElementi = ContaElementi + 1
CasiVincenti = 0
CasiTotali = 0
For EstrStorica = Inizio To (UltimaEstrazioneValida - 4)
If ScegliIndice = 0 Or IndiceMensile(EstrStorica) = ScegliIndice Then
CasiTotali = CasiTotali + 1
Num1 = Estratto(EstrStorica, R1, 1)
Num2 = Estratto(EstrStorica, R1, 2)
S_Ambata1 = Num1 - Num2
If S_Ambata1 <= 0 Then S_Ambata1 = S_Ambata1 + 90 End If
S_Vert1 = CalcolaVertibileTabella(S_Ambata1)
Num1 = Estratto(EstrStorica, R2, 1)
Num2 = Estratto(EstrStorica, R2, 2)
S_Ambata2 = Num1 - Num2
If S_Ambata2 <= 0 Then S_Ambata2 = S_Ambata2 + 90 End If
S_Vert2 = CalcolaVertibileTabella(S_Ambata2)
NumeriQuartina(1) = S_Ambata1
NumeriQuartina(2) = S_Vert1
NumeriQuartina(3) = S_Ambata2
NumeriQuartina(4) = S_Vert2
' Verifica rapida nativa senza annidamenti pesanti ruota per ruota
If SerieFreq(EstrStorica + 1, EstrStorica + 4, NumeriQuartina, RuoteVerifica, 2) > 0 Then
CasiVincenti = CasiVincenti + 1
End If
End If
Next
If CasiTotali > 0 Then
Percentuale = (CasiVincenti / CasiTotali) * 100
Else
Percentuale = 0
End If
' Strategia matematica per la ruota consigliata: giochiamo sulle ruote di origine dei calcoli
' Statisticamente l'ambo su Tutte tende a ripetersi sulle ruote che hanno generato i numeri
RuotaMiglioreId = R1
Scrivi "METODO STRUTTURALE # " & ContaElementi, 1, , vbRed, vbWhite
Scrivi "Combinazione d'origine: [" & NomeRuota(R1) & " Pos.1-2] + [" & NomeRuota(R2) & " Pos.1-2]", 1
Scrivi "RENDIMENTO STORICO GLOBALE: " & CasiVincenti & " su " & CasiTotali & " casi (" & Round(Percentuale, 2) & "%)", 1, , vbGreen, vbBlack
Scrivi "RUOTA SINGOLA CONSIGLIATA DA STATISTICA: " & UCase(NomeRuota(RuotaMiglioreId)), 1, , vbYellow, vbBlack
Num1 = Estratto(UltimaEstrazioneValida, R1, 1)
Num2 = Estratto(UltimaEstrazioneValida, R1, 2)
P_Ambata1 = Num1 - Num2
If P_Ambata1 <= 0 Then P_Ambata1 = P_Ambata1 + 90 End If
P_Vert1 = CalcolaVertibileTabella(P_Ambata1)
Num1 = Estratto(UltimaEstrazioneValida, R2, 1)
Num2 = Estratto(UltimaEstrazioneValida, R2, 2)
P_Ambata2 = Num1 - Num2
If P_Ambata2 <= 0 Then P_Ambata2 = P_Ambata2 + 90 End If
P_Vert2 = CalcolaVertibileTabella(P_Ambata2)
Scrivi "QUARTINA DA GIOCARE PER AMBO (SU " & UCase(NomeRuota(RuotaMiglioreId)) & " E TUTTE): " & P_Ambata1 & " - " & P_Vert1 & " - " & P_Ambata2 & " - " & P_Vert2, 1, , vbYellow, vbRed
Scrivi "Tracciamento sfaldamento reale della Quartina fino a oggi:", 1
TrovatoEsito = False
NumeriQuartina(1) = P_Ambata1
NumeriQuartina(2) = P_Vert1
NumeriQuartina(3) = P_Ambata2
NumeriQuartina(4) = P_Vert2
ColpoVer = 0
For EstrVer = (UltimaEstrazioneValida + 1) To EstrattoFinUltimo
ColpoVer = ColpoVer + 1
If SerieFreq(EstrVer, EstrVer, NumeriQuartina, RuoteVerifica, 2) > 0 Then
Scrivi " -> COLPO " & ColpoVer & " (" & DataEstrazione(EstrVer) & "): ESITO VINCENTE DI AMBO IN QUARTINA SU UNA DELLE RUOTE", 1, , vbGreen, vbWhite
TrovatoEsito = True
End If
Next
If TrovatoEsito = False Then
Scrivi "Stato Attuale: La quartina è ancora INTEGRALMENTE VERGINE (Nessun ambo uscito).", 1, , vbCyan, vbBlack
If CombinazioniVergini_Count < 10 Then
CombinazioniVergini_Count = CombinazioniVergini_Count + 1
Record_N1(CombinazioniVergini_Count) = P_Ambata1
Record_N2(CombinazioniVergini_Count) = P_Vert1
Record_N3(CombinazioniVergini_Count) = P_Ambata2
Record_N4(CombinazioniVergini_Count) = P_Vert2
End If
End If
Scrivi "--------------------------------------------------------------------------------"
Scrivi
End If
Next
Next
Scrivi "================================================================================", 1
Scrivi "=== SPECCHIETTO RIASSUNTIVO: QUARTINE VERGINI PER AMBO DA GIOCARE OGGI ===", 1, , vbGreen, vbWhite
Scrivi "================================================================================", 1
If CombinazioniVergini_Count > 0 Then
For i = 1 To CombinazioniVergini_Count
Scrivi " -> QUARTINA #" & i & " SU TUTTE: " & Record_N1(i) & " - " & Record_N2(i) & " - " & Record_N3(i) & " - " & Record_N4(i), 1, , vbYellow, vbRed
Next
Else
Scrivi "Nessuna combinazione vergine rilevata nel ciclo attuale. Tutte hanno già pagato l'ambo.", 1
End If
Scrivi "================================================================================"
Scrivi "Fine elaborazione globale."
End Sub
Function CalcolaVertibileTabella(Numero)
Dim Resp
Select Case Numero
Case 1
Resp = 10
Case 10
Resp = 1
Case 2
Resp = 20
Case 20
Resp = 2
Case 3
Resp = 30
Case 30
Resp = 3
Case 4
Resp = 40
Case 40
Resp = 4
Case 5
Resp = 50
Case 50
Resp = 5
Case 6
Resp = 60
Case 60
Resp = 6
Case 7
Resp = 70
Case 70
Resp = 7
Case 8
Resp = 80
Case 80
Resp = 8
Case 9
Resp = 90
Case 90
Resp = 9
Case 11
Resp = 19
Case 19
Resp = 11
Case 22
Resp = 29
Case 29
Resp = 22
Case 33
Resp = 39
Case 39
Resp = 33
Case 44
Resp = 49
Case 49
Resp = 44
Case 55
Resp = 59
Case 59
Resp = 55
Case 66
Resp = 69
Case 69
Resp = 66
Case 77
Resp = 79
Case 79
Resp = 77
Case 88
Resp = 89
Case 89
Resp = 88
Case Else
Dim Un, Da
Un = Numero Mod 10
Da = Int(Numero / 10)
Resp = (Un * 10) + Da
End Select
CalcolaVertibileTabella = Resp
End Function
