Chiedo ai super power scripters come magia, joe, ilegend ecc...

[lotto_tom75]

Se è possibile avere direttamente, o delle dritte per poter costruire, uno script x million day che faccia questo...

valutare per ogni estrazione un range delle ultime 11 estrazioni
valutare per ogni range "dinamico" di questa estensione temporale i numeri usciti inserendoli x ciascuna estrazione in 3 categorie o insiemi precisi secondo queste tre rispettive particolarità di presenza (frequenza) nel range dinamico di 11 estrazioni analizzato:

insieme A : fq > 1
insieme B : fq = 1
insieme C : fq = 0

Ottimale sarebbe se alla fine dell'elaborazione si riuscisse a visualizzare un report di questo tipo:

esempio fittizio...

ecc...
24-1-2020 : A+4B oppure ABBBB
25-1-2020 : AA2BC oppure AABBC
26-1-2020 : A+3B+C oppure ABBBC
ecc...

la ciliegina sulla torta sarebbe avere per ogni insieme A,B e C per ogni range temporale di 11 estrazioni anche i relativi numeri...

Sono quasi sicuro, visto precedenti esperienze con il superena per p3, che un filtraggio di questo tipo potrebbe aiutare molto a scremare diverse tipologie di formazioni analitico riduzionali

Un caro saluto a tutti/e

Altre info al riguardo di questo mio nuovo tipo di filtraggio sperimentale x MD le trovate qui. Ad ogni modo per qualsiasi ulteriore eventuale chiarimento chiedete h24 without problem ?

 

[lotto_tom75]

Dunque...

Forse come, avviene spesso ultimamente..., ce l'ho fatta da solo! ??

Option Explicit

Sub Main

   Dim sFileArchivio : sFileArchivio = GetDirectoryAppData & "Archivio MillionDAY\MillionDay-aggiornamento-aggiornato-ultima-estrazione.txt" 'MillionDayMD.txt"
   Call ApriBaseDatiFT(sFileArchivio,05,";",55)
   Dim Inizio,Fine : Inizio = EstrazioniArchivioFT- 11 : Fine = EstrazioniArchivioFT
   Dim nSorte : nSorte = 1
   'Dim sFile : sFile = ScegliFile("c:\lunghette",".txt","lunghette.txt")
   Dim k,y
   Dim RetRit,RetRitMax,RetIncrRitMax,RetFreq
   Call Messaggio("Lettura file di testo")
   ReDim aRighe(00)
   Dim sfile

Dim anum

   sfile = ScegliFile(".\")

   Scrivi "file scelto: " & sfile

   Call LeggiRigheFileDiTesto(sfile,aRighe)

   For k = 0 To UBound(aRighe)

   If aRighe(k) <> "" Then

   Call SplitByChar("." & aRighe(k),".",anum)




Dim quantitanumeriscelti
'ReDim aNum(0)
'quantitanumeriscelti = ScegliNumeri(aNum)
Dim coltot,Classe,acol
Classe = 1



coltot = InitSviluppoIntegrale(anum,Classe)

If coltot > 0 Then


Call Scrivi
Call Scrivi(" Sviluppo in classe: " & Classe & " per punti " & nSorte)
Call Scrivi



Do While GetCombSviluppo(acol) = True



         Call StatisticaFormazioneFT(acol,nSorte,RetRit,RetRitMax,RetIncrRitMax,RetFreq,Inizio,Fine)
         RetRit = RitardoCombinazioneFT(acol,nSorte,Fine)
         Dim Diff
         Diff = RetRitMax - RetRit
   
         If(RetRit >= 0 And RetFreq > 1) Then
         Call Scrivi ("A: " & StringaNumeri(acol))                    
        Else  If(RetRit >= 0 And RetFreq = 1) Then
         Call Scrivi ("B: " & StringaNumeri(acol))   
        Else  If(RetRit >= 0 And RetFreq = 0) Then 
         Call Scrivi ("C: " & StringaNumeri(acol))
         End If
         End If
         End If
         'End If

      If k Mod 100 = 000 Then
         Call Messaggio("Colonna : " & k)

      End If
      'End If
      'End If
      'End If
      'End If


      If ScriptInterrotto Then Exit Do
      Loop

      End If
   'Next
  End If
  Next

End Sub

Ma purtroppo credo di aver fatto comunque degli errori di "ciclo" riguardo le 11 estrazioni desiderate.. per ogni fascia temporale analizzata... ? Infatti da un'analisi "manuale" l'ultimo schema del 26-1-2020 dovrebbe risultare A+3B+C o A+BBB+C invece se si esegue questo mio script si ottiene per la stessa data:

A: 1
B: 2
A: 18
A: 36
A: 46

?

Adesso quindi mi servirebbe solo una mano per controllare la corretta ciclicità dello script e per sistemarla nel caso, come penso, sia errata...

Grazie mille anticipate a chi lo farà

Last update: Ha ragione lo script! ??? Ho verificato con excel... e sembra che avessi fatto un errore di valutazione con l'analisi manuale!!! Me feliceee ?

 

[lotto_tom75]

Mi sarebbe rimasta da fare questa ottimizzazione dell'output...

Questo code...

         If(RetRit >= 0 And RetFreq > 1) Then
                            
         Call Scrivi ("A") 
        Else  If(RetRit >= 0 And RetFreq = 1) Then 
        
         Call Scrivi ("B")      
        Else  If(RetRit >= 0 And RetFreq = 0) Then       

         Call Scrivi ("C")

mi riporta a video un output di questo tipo "verticale" e "non ordinato"

-----
C
C
B
B
B
-----
B
C
B
A
C
-----

mentre a me servirebbe che lo riportasse in "orizzontale" e ordinandolo alfabeticamente dalla A alla C in questo modo (sempre seguendo l'esempio soprastante...):

BBBCC
ABBCC

Qualcuno/a saprebbe dirmi come fare per ottenere questa visualizzazione in orizzontale e ordinata da sinistra a destra in modo alfabetico? Grazie

 

[joe]

Ciao Tom.

Lo script non lo voglio neppure vedere ...

e quel gioco per me è peggio che il fumo negli occhi.

Però ... se ti sei mantenuto ordinato con le lettere "ABC" MAIUSCOLE

esse hanno un codice ascii progressivo.

Quindi SE confronti ogni carattere con il valore del carattere Ascii di riferimento,

potrai mandarlo in output se esso le rappresenta e gli appartiene.

In sintesi saranno ordinate progressivamente .... come lo sono i Numeri.

Option Explicit
Sub Main
  Dim A,S,I
  S = "BCBAC"
  For A = 65 To 67
    For I = 1 To Len(S)
      If Asc(Mid(S,I,1)) = A Then Scrivi Chr(A),False,False
    Next
  Next
  Scrivi
End Sub

 

[lotto_tom75]

Ciao Tom.

Lo script non lo voglio neppure vedere ...

e quel gioco per me è peggio che il fumo negli occhi.

Però ... se ti sei mantenuto ordinato con le lettere "ABC" MAIUSCOLE

esse hanno un codice ascii progressivo.

Quindi SE confronti ogni carattere con il valore del carattere Ascii di riferimento,

potrai mandarlo in output se esso le rappresenta e gli appartiene.

In sintesi saranno ordinate progressivamente .... come lo sono i Numeri.

Option Explicit
Sub Main
  Dim A,S,I
  S = "BCBAC"
  For A = 65 To 67
    For I = 1 To Len(S)
      If Asc(Mid(S,I,1)) = A Then Scrivi Chr(A),False,False
    Next
  Next
  Scrivi
End Sub

Grazie joe ma così non riesco proprio ad implementarlo
A me basterebbe... che i risultati che ottengo dallo script soprastante mi tornassero a video uno sotto l'altro in orizzontale e ordinati alfabeticamente dalla A alla C. Grazie comunque. Ciao

 

[joe]

Grazie joe ma così non riesco proprio ad implementarlo
A me basterebbe... che i risultati che ottengo dallo script soprastante mi tornassero a video uno sotto l'altro in orizzontale e ordinati alfabeticamente dalla A alla C. Grazie comunque. Ciao

in orizzontale e ordinandolo alfabeticamente dalla A alla C in questo modo (sempre seguendo l'esempio soprastante...):

ABBCC

"Orizzontale" vuol "Verticale" (al contrario dell' esempio e della richiesta)?

 

[lotto_tom75]

"Orizzontale" vuol "Verticale" (al contrario dell' esempio e della richiesta)?

Ciao joe non ho capito cosa non hai capito
ma per farti un esempio visivo di cosa vorrei ottenere te ne riporto un es. del tutto fittizio qui sotto:

AABBC
----------
BBCCC
----------
AAABB
----------
ecc...

mentre io per adesso ottengo qualcosa di questo tipo (sempre seguendo l'esempio fittizio sopra...):

A
A
C
B
B
--------
C
B
B
C
C
--------
B
A
B
A
A
--------

 

[joe]

I problemi sono diversi

I risultati una volta scritti disordinati ... disordinati rimangono.

Primo, li devi "intercettare" e conservare PRIMA che siano scritti.

Secondo ci devono essere tutti altrimenti non li puoi ordinare.

Terzo devi ordinarli ... ma è già risolto.

Quarto ... Il formato in output orizzontale (o verticale)

è anch'esso facilmente risolvibile.

 

[joe]

Dunque ....

... se era giusto, quanto ti ho proposto, devi solo mettere assieme i caratteri sparsi e disordinati.

Cioè comporre la stringa "S"

         S= ""

        If(RetRit >= 0 And RetFreq > 1) Then
         S = S &"A"           
         'Call Scrivi ("A") 
        Else  If(RetRit >= 0 And RetFreq = 1) Then 
         S = S &"B"  
         'Call Scrivi ("B")      
        Else  If(RetRit >= 0 And RetFreq = 0) Then       
         S = S &"C"  
         'Call Scrivi ("C")
         Call Scrivi  (S)

Poi ... puoi richiamare lo script precedente

eventualmente trasformato in funzione

OrdinaStringa (S)

 

[lotto_tom75]

Ciao joe grazie mille! Implementando la tua soluzione ci sono quasi... ?

Option Explicit

Sub Main

   Dim sFileArchivio : sFileArchivio = GetDirectoryAppData & "Archivio MillionDAY\MillionDay-aggiornamento-aggiornato-ultima-estrazione.txt" 'MillionDayMD.txt"
   Call ApriBaseDatiFT(sFileArchivio,05,";",55)
   Dim Inizio,Fine : Inizio = EstrazioniArchivioFT - 11 : Fine = EstrazioniArchivioFT
   Dim nSorte : nSorte = 1
   'Dim sFile : sFile = ScegliFile("c:\lunghette",".txt","lunghette.txt")
   Dim k,y
   Dim RetRit,RetRitMax,RetIncrRitMax,RetFreq
   Call Messaggio("Lettura file di testo")
   ReDim aRighe(00)
   Dim sfile

Dim anum
  
   sfile = ScegliFile(".\")
  
   Scrivi "file scelto: " & sfile
  
   Call LeggiRigheFileDiTesto(sfile,aRighe)
  
   For k = 0 To UBound(aRighe)
  
   If aRighe(k) <> "" Then
  
   Call SplitByChar("." & aRighe(k),".",anum)



 
Dim quantitanumeriscelti
'ReDim aNum(0)
'quantitanumeriscelti = ScegliNumeri(aNum)
Dim coltot,Classe,acol
Classe = 1



coltot = InitSviluppoIntegrale(anum,Classe)

If coltot > 0 Then


'Call Scrivi
'Call Scrivi(" Sviluppo in classe: " & Classe & " per punti " & nSorte)
'Call Scrivi
Call Scrivi("-----")



Do While GetCombSviluppo(acol) = True



         Call StatisticaFormazioneFT(acol,nSorte,RetRit,RetRitMax,RetIncrRitMax,RetFreq,Inizio,Fine)
         RetRit = RitardoCombinazioneFT(acol,nSorte,Fine)
         Dim Diff
         Diff = RetRitMax - RetRit
         Dim S
        
         If(RetRit >= 0 And RetFreq > 1) Then
         'Call Scrivi ("A: " & StringaNumeri(acol))
         'Call Scrivi("A")
         S = S & "A"
        Else If(RetRit >= 0 And RetFreq = 1) Then
         'Call Scrivi ("B: " & StringaNumeri(acol))
         'Call Scrivi("B")
         S = S & "B"
        Else If(RetRit >= 0 And RetFreq = 0) Then
         'Call Scrivi ("C: " & StringaNumeri(acol))
         'Call Scrivi("C")
         S = S & "C"
         
         End If
         End If
         End If
      
         'End If

      If k Mod 100 = 000 Then
         Call Messaggio("Colonna : " & k)

      End If
      'End If
      'End If
      'End If
      'End If
     
     
      If ScriptInterrotto Then Exit Do
       Call OrdinaStringa(S)
        Call Scrivi(S)
       
      Loop
      S = ""
      End If
   'Next
  End If
  Next

End Sub


Sub OrdinaStringa(S)
  Dim A,I
  'S = "BCBAC"
  For A = 65 To 67
    For I = 1 To Len(S)
      If Asc(Mid(S,I,1)) = A Then Scrivi Chr(A),False,False
    Next
  Next
  Scrivi
  End Sub

Se non utilizzo la funzione OrdinaStringa che non mi funzia... ottengo la sequenza disordinata ma in orizzontale anche se mi stampa a video anche tutti i vari passaggi (ma non importa). Solo che appunto la funzione OrdinaStringa non mi funge...

 

[lotto_tom75]

Con questa ultima prova che ti posto qui sotto joe ottengo quasi l'output sperato.. solo che mi stampa anche 10 caratteri prima "non desiderati" In sostanza gli ultimi 5 caratteri di ogni riga sono corretti e ordinati in modo alfabetico.. vorrei eliminare i precedenti 10 però...

Ho provato come puoi vedere dalla varie 'S="" disseminate un pò dappertutto... ? ad azzerare quei 10 valori iniziali ma non c'è stato modo almeno fino ad ora... ?

Option Explicit

Sub Main

   Dim sFileArchivio : sFileArchivio = GetDirectoryAppData & "Archivio MillionDAY\MillionDay-aggiornamento-aggiornato-ultima-estrazione.txt" 'MillionDayMD.txt"
   Call ApriBaseDatiFT(sFileArchivio,05,";",55)
   Dim Inizio,Fine : Inizio = EstrazioniArchivioFT - 11 : Fine = EstrazioniArchivioFT
   Dim nSorte : nSorte = 1
   'Dim sFile : sFile = ScegliFile("c:\lunghette",".txt","lunghette.txt")
   Dim k,y
   Dim RetRit,RetRitMax,RetIncrRitMax,RetFreq
   Call Messaggio("Lettura file di testo")
   ReDim aRighe(00)
   Dim sfile

Dim anum
 
   sfile = ScegliFile(".\")
 
   Scrivi "file scelto: " & sfile
 
   Call LeggiRigheFileDiTesto(sfile,aRighe)
 
   For k = 0 To UBound(aRighe)
 
   If aRighe(k) <> "" Then
 
   Call SplitByChar("." & aRighe(k),".",anum)




Dim quantitanumeriscelti
'ReDim aNum(0)
'quantitanumeriscelti = ScegliNumeri(aNum)
Dim coltot,Classe,acol
Classe = 1



coltot = InitSviluppoIntegrale(anum,Classe)

If coltot > 0 Then


'Call Scrivi
'Call Scrivi(" Sviluppo in classe: " & Classe & " per punti " & nSorte)
'Call Scrivi
Call Scrivi("<br>-----")



Do While GetCombSviluppo(acol) = True



         Call StatisticaFormazioneFT(acol,nSorte,RetRit,RetRitMax,RetIncrRitMax,RetFreq,Inizio,Fine)
         RetRit = RitardoCombinazioneFT(acol,nSorte,Fine)
         Dim Diff
         Diff = RetRitMax - RetRit
         Dim S
       
         If(RetRit >= 0 And RetFreq > 1) Then
         'Call Scrivi ("A: " & StringaNumeri(acol))
         'Call Scrivi("A")
         S = S & "A"
        Else If(RetRit >= 0 And RetFreq = 1) Then
         'Call Scrivi ("B: " & StringaNumeri(acol))
         'Call Scrivi("B")
         S = S & "B"
        Else If(RetRit >= 0 And RetFreq = 0) Then
         'Call Scrivi ("C: " & StringaNumeri(acol))
         'Call Scrivi("C")
         S = S & "C"
        
         End If
         End If
         End If
     
         'End If

      If k Mod 100 = 000 Then
         Call Messaggio("Colonna : " & k)

      End If
      'End If
      'End If
      'End If
      'End If
    
    
      If ScriptInterrotto Then Exit Do
       Call OrdinaStringa(S)
        'Call Scrivi(S)
        'S=""
      Loop
      S = ""
      End If
      S=""
   'Next
  End If
  S=""
  Next
S=""
End Sub


Sub OrdinaStringa(S)
  Dim A,I
  'S = "BCBAC"
  For A = 65 To 67
    For I = 1 To Len(S)
      If Asc(Mid(S,I,1)) = A Then
      Scrivi Chr(A),False,False
      'S=""
      End If
      'S=""
    Next
    'S=""
  Next
  'Scrivi S
  'S=""
  End Sub

Grazie alla funzione EXCEL: =DESTRA(A1;5)
Sono riuscito ad ottenere dall'output "non proprio ottimale" dello scrpt postato qui sopra la sequenza ABC per ogni estrazione ma mi piacerebbe poterla ottenere anche "pulita" direttamente dallo script stesso. Guarda un pò se vuoi se puoi riferirmi dove ho sbagliato nel codice soprastante joe. Ad ogni modo grazie mille per quanto fatto finora big!

 

[joe]

Option Explicit
Sub Main
   Dim S
   S = "BCBAC"
   Scrivi "Input  " & S
   Scrivi "Output " & StringaOrdinata(S)
End Sub
Function StringaOrdinata(S)
   Dim A,I,T
   T = ""
   For A = 65 To 67
      For I = 1 To Len(S)
         If Asc(Mid(S,I,1)) = A Then T = T & Chr(A)
         'Scrivi Chr(A),False,False
         'S=""
         'End If
         'S=""
      Next
      'S=""
   Next
   'Scrivi S
   'S=""
   StringaOrdinata = T
End Function

 

[lotto_tom75]

Adesso l'output è davvero quasi perfetto... ??? THANKS joe!!!

Output C
Output CC
Output BCC
Output BBCC
Output BBBCC <<< ordinato in modo alfabetico e in orizzontale con soli 5 caratteri! OK!

-----
Output A
Output AC
Output ABC
Output ABBC
Output ABBCC <<< ordinato in modo alfabetico e in orizzontale con soli 5 caratteri! OK!

-----
Output B
Output BC
Output BCC
Output ABCC
Output ABBCC <<< ordinato in modo alfabetico e in orizzontale con soli 5 caratteri! OK!

L'unica ulteriore ottimizzazione che potrei apportarvi, se solo sapessi come fare... ,sarebbe quella di eliminare la visualizzazione dei 4 step precedenti... che nell'esempio sopra ho barrato appositamente

Option Explicit

Sub Main

   Dim sFileArchivio : sFileArchivio = GetDirectoryAppData & "Archivio MillionDAY\MillionDay-aggiornamento-aggiornato-ultima-estrazione.txt" 'MillionDayMD.txt"
   Call ApriBaseDatiFT(sFileArchivio,05,";",55)
   Dim Inizio,Fine : Inizio = EstrazioniArchivioFT - 11 : Fine = EstrazioniArchivioFT
   Dim nSorte : nSorte = 1
   'Dim sFile : sFile = ScegliFile("c:\lunghette",".txt","lunghette.txt")
   Dim k,y
   Dim RetRit,RetRitMax,RetIncrRitMax,RetFreq
   Call Messaggio("Lettura file di testo")
   ReDim aRighe(00)
   Dim sfile

Dim anum

'Dim Stringaordinata

   
   sfile = ScegliFile(".\")
   
   Scrivi "file scelto: " & sfile
   
   Call LeggiRigheFileDiTesto(sfile,aRighe)
   
   For k = 0 To UBound(aRighe)
   
   If aRighe(k) <> "" Then
   
   Call SplitByChar("." & aRighe(k),".",anum)



  
Dim quantitanumeriscelti
'ReDim aNum(0)
'quantitanumeriscelti = ScegliNumeri(aNum)
Dim coltot,Classe,acol
Classe = 1



coltot = InitSviluppoIntegrale(anum,Classe)

If coltot > 0 Then


'Call Scrivi
'Call Scrivi(" Sviluppo in classe: " & Classe & " per punti " & nSorte)
'Call Scrivi
Call Scrivi("<br>-----")



Do While GetCombSviluppo(acol) = True



         Call StatisticaFormazioneFT(acol,nSorte,RetRit,RetRitMax,RetIncrRitMax,RetFreq,Inizio,Fine)
         RetRit = RitardoCombinazioneFT(acol,nSorte,Fine)
         Dim Diff
         Diff = RetRitMax - RetRit
         Dim S
         'S=""
         If(RetRit >= 0 And RetFreq > 1) Then
         'Call Scrivi ("A: " & StringaNumeri(acol))
         'Call Scrivi("A")
         S = S & "A"
        Else If(RetRit >= 0 And RetFreq = 1) Then
         'Call Scrivi ("B: " & StringaNumeri(acol))
         'Call Scrivi("B")
         S = S & "B"
        Else If(RetRit >= 0 And RetFreq = 0) Then
         'Call Scrivi ("C: " & StringaNumeri(acol))
         'Call Scrivi("C")
         S = S & "C"
          
         End If
         'Call OrdinaStringa(S)
         End If
         'Call OrdinaStringa(S)
         End If
       'Call OrdinaStringa(S)
       
         'End If

      If k Mod 100 = 000 Then
         Call Messaggio("Colonna : " & k)

      End If
      'End If
      'End If
      'End If
      'End If
      
      'Call OrdinaStringa(S)
      
      If ScriptInterrotto Then Exit Do
       'Call OrdinaStringa(S)
       
       Call OrdinaStringa(S)
       
        'Call Scrivi(S)
        'S=""
      Loop
      
      
      S = ""
      End If
      S = ""
   'Next
  End If
  S = ""
  Next
 S = ""
End Sub


Sub OrdinaStringa(S)
 Dim Stringaordinata
  Dim A,I,T
   T = ""
   For A = 65 To 67
      For I = 1 To Len(S)
         If Asc(Mid(S,I,1)) = A Then T = T & Chr(A)
         'Scrivi Chr(A),False,False
         'S=""
         'End If
         'S=""
      Next
      'S=""
   Next
   'Scrivi S
   'S=""
   Stringaordinata = T
   'Scrivi "Input  " & S
   Scrivi "Output " & Stringaordinata
  End Sub

 

[joe]

Tom,

l'utilizzo di quello script è uno dei migliori esercizi possibili

per far andare fuori di testa. Cioè sballarsi senza sostanze.

Se indenti il codice vedi, per esempio, che "do" ancicchè chiudere con loop, si allinea ad un next.

Dunque ho tirato via moltissime cose e semplificato un pò.

Non ho la minima idea se possa essere ancora funzionante anche perché

non ho un archivio e non intendo provare se gira e poi debuggarlo.

Così, ad occhio, mi sembra potrebbe essere migliore.

Ma ... come ho detto, non intendo diventarci matto.

Option Explicit
Sub Main
   Dim sFileArchivio : sFileArchivio = GetDirectoryAppData & "Archivio MillionDAY\MillionDay-aggiornamento-aggiornato-ultima-estrazione.txt" 'MillionDayMD.txt"
   Call ApriBaseDatiFT(sFileArchivio,05,";",55)
   Dim Inizio,Fine : Inizio = EstrazioniArchivioFT - 11 : Fine = EstrazioniArchivioFT
   Dim nSorte : nSorte = 1
   'Dim sFile : sFile = ScegliFile("c:\lunghette",".txt","lunghette.txt")
   Dim k,y,S
   Dim RetRit,RetRitMax,RetIncrRitMax,RetFreq
   Call Messaggio("Lettura file di testo")
   ReDim aRighe(00)
   Dim sfile
   Dim anum
   'Dim Stringaordinata
   sfile = ScegliFile(".\")
   Scrivi "file scelto: " & sfile
   Call LeggiRigheFileDiTesto(sfile,aRighe)
   For k = 0 To UBound(aRighe)
      If aRighe(k) <> "" Then
         Call SplitByChar("." & aRighe(k),".",anum)
         Dim quantitanumeriscelti
         'ReDim aNum(0)
         'quantitanumeriscelti = ScegliNumeri(aNum)
         Dim coltot,Classe,acol
         Classe = 1
         coltot = InitSviluppoIntegrale(anum,Classe)
         If coltot > 0 Then
            Call Scrivi("<br>-----")
            Do While GetCombSviluppo(acol) = True
               Call StatisticaFormazioneFT(acol,nSorte,RetRit,RetRitMax,RetIncrRitMax,RetFreq,Inizio,Fine)
               RetRit = RitardoCombinazioneFT(acol,nSorte,Fine)
               Dim Diff
               Diff = RetRitMax - RetRit
               S = ""
               If RetRit >= 0 Then
                  If RetFreq > 1 Then S = S & "A"
                  If RetFreq = 1 Then S = S & "B"
                  If RetFreq = 0 Then S = S & "C"
               End If
               If k Mod 100 = 0 Then
                  Call Messaggio("Colonna : " & k)
               End If
               If ScriptInterrotto Then Exit Do
            Loop
            Call Scrivi(StringaOrdinata(S))
         End If
      End If
   Next
End Sub
Function StringaOrdinata(S)
   Dim A,I,T
   T = ""
   For A = 65 To 67
      For I = 1 To Len(S)
         If Asc(Mid(S,I,1)) = A Then T = T & Chr(A)
      Next
   Next
   StringaOrdinata = T
End Function

 

[lotto_tom75]

Eh eh joe ? no no non diventarci matto! Anche se purtroppo questa tua ultima versione non funzia o meglio mi rende un output come questo:

B

-----
C

-----
B

-----
A

-----

non è affatto necessario nè richiesto che tu divenga matto per farne una versione ottimizzata! ?
Grazie mille di nuovo per quanto fatto finora e la penultima versione che ho postato seguendo le tue dritte va più che bene tanto che ho già quanto volevo estrapolare dall'archivio MD ovvero le quantità teorica dei vari schemi ABC di sfaldamento che, anche se mi pare d'aver capito non ti interessi minimamente questo gioco, riporto per te e per chi volesse curiosare anche qui.

Grazie di nuovo joe ??

 

[joe]

Ciao Tom,

ripeto non avendo l'archivio e la conoscenza del gioco ... non posso controllare.

Tuttavia quanto t'ho detto dovrebbe funzionare. BENE.

Dunque se la funzione che t'ho dato non si comporta bene è perché non è richiamata correttamente.

In sintesi secondo me lo script è sbagliato e le correzioni che ne hai fatto sono sbagliate.

Come t'ho detto, secondo me la funzione deve essere richiamata SOLO quando sono disponibili

TUTTE LE LETTERE DA ORDINARE e deve restituirle tutte ordinate.

(cfr msg #8 : "ci devono essere tutti altrimenti non li puoi ordinare. ")

In sintesi non c'è e non ci deve essere niente da cancellare.

Buona Serata.

PS: A corredo e per confermare la mia ipotesi ho aggiunto allo script presente al msg 12

un simulatore o generatore casuale di lettere che da conferma di quanto t'ho scritto poco sopra.

Option Explicit
Sub Main
  Dim X,Y,S
  For X = 1 To 10
    S = ""
    For Y = 1 To 5
      S = S & Chr(NumeroCasuale(65,67))
    Next
    Scrivi "Input  " & S
    Scrivi "Output " & StringaOrdinata(S)
    Scrivi String(12,"-")
  Next
End Sub

Function StringaOrdinata(S)
  Dim A,I,T
  T = ""
  For A = 65 To 67
    For I = 1 To Len(S)
      If Asc(Mid(S,I,1)) = A Then T = T & Chr(A)
    Next
  Next
  StringaOrdinata = T
End Function