discussione:Richiesta per listato su statistica di cicli reali

[vincenzo4221]

Ciao, questa discussione di cui sopra è stata pubblicata nel 2011 con la intiuzione del bravo Roby , ma rimane attualmente di mio interesse, gli script però sono inservibili perchè
mancano (appositamente??) delle stringhe di codici quali ad esempio " End" ....si potrebbero rendere utili a tutti questi bei lavori?

 

[druid]

Ciao Vincenzo,
uno degli script dovrebbe essere questo (l'avevo salvato sul pc a suo tempo)

Class clsAmbo
   Public abNum(90)
   Public aNum(2)
   Public Capogioco
   Public nCicliDaCalc
   Public PresPerCicliPratici
   Public PresenzeAttuali
   Sub InitCicliDaCalc(nCicliDaCalc)
      Dim k
      PresenzeAttuali = 0
      ReDim PresPerCicliPratici(nCicliDaCalc)
      For k = 0 To nCicliDaCalc
         PresPerCicliPratici(k) = 0
      Next
   End Sub
   Sub SetAmbo(n1,n2)
      abNum(n1) = True
      abNum(n2) = True
      If n1 < n2 Then
         aNum(1) = n1
         aNum(2) = n2
      Else
         aNum(1) = n2
         aNum(2) = n1
      End If
   End Sub
   Function GetNumeriString
      GetNumeriString = Format2(aNum(1)) & "." & Format2(aNum(2))
   End Function
   Function GetSommaPresenze
      Dim t
      Dim k
      For k = 1 To UBound(PresPerCicliPratici)
         t = t + PresPerCicliPratici(k)
      Next
      GetSommaPresenze = t
   End Function
End Class
Sub Main
   Dim CollAmbi
   Dim clsA
   Dim nCapogioco
   Dim aRuote,abRuote
   Dim nRuoteSel
   Dim nInizioRangeAnalisi
   Dim nFineRangeAnalisi
   Dim nInizioTmp
   Dim retInizioCiclo,retFineCiclo
   Dim aLimitiCicli
   Dim k,j
   Dim nCicliTrovati
   Dim nNumScelti
   ' attenzione il range analizzato parte dall'estrazione del 14/9/1946 fino all'estrazione corrrentemente impostata
   ' come limite superiore nel range del programma
   nInizioRangeAnalisi = DataEstrToIdEstr(14,9,1946)
   nFineRangeAnalisi = EstrazioneFin
   'nCapogioco = InputBox("Inserire un numero per il capogioco","Capogioco",1)
   ReDim aNumeri(0)
   nNumScelti = ScegliNumeri(aNumeri)
   nRuoteSel = ScegliRuote(aRuote,abRuote)
   Call GestioneAutomaticaRuotaTutte(aRuote,abRuote,nRuoteSel)
   If nCapogioco <> "" Then nCapogioco = CInt(nCapogioco)



   If nRuoteSel > 0 And nNumScelti > 0 Then
      Call Scrivi("Inizio analisi " & GetInfoEstrazione(nInizioRangeAnalisi))
      Call Scrivi("Fine analisi   " & GetInfoEstrazione(nFineRangeAnalisi))
      Call Scrivi

      Set CollAmbi = GetNewCollection
      For j = 1 To nNumScelti
         nCapogioco = aNumeri(j)
         nCicliTrovati = 0
         ReDim aLimitiCicliMin(nCicliTrovati)
         ReDim aLimitiCicliMax(nCicliTrovati)
         Call AlimentaCollAmbi(CollAmbi,nCapogioco)
         nInizioTmp = nInizioRangeAnalisi
         retInizioCiclo = 0
         retFineCiclo = 0
         Do While CalcolaCicloPratico(nInizioTmp,retInizioCiclo,retFineCiclo,nCapogioco,abRuote,nFineRangeAnalisi)
            nCicliTrovati = nCicliTrovati + 1
            ReDim Preserve aLimitiCicliMin(nCicliTrovati)
            ReDim Preserve aLimitiCicliMax(nCicliTrovati)
            aLimitiCicliMin(nCicliTrovati) = retInizioCiclo
            aLimitiCicliMax(nCicliTrovati) = retFineCiclo
            nInizioTmp = retFineCiclo + 1
         Loop
         ReDim abCicliDaCalcolare(nCicliTrovati)
         If ScegliCicliDaCalcolare(aLimitiCicliMin,aLimitiCicliMax,abCicliDaCalcolare,nCapogioco) Then
            For Each clsA In CollAmbi
               Call clsA.InitCicliDaCalc(nCicliTrovati)
            Next
            For k = 1 To nCicliTrovati
               If abCicliDaCalcolare(k) Then
                  Call Messaggio("Conteggio presenze nel ciclo " & k & _
                  " estrazioni " & aLimitiCicliMin(k) & "/" & aLimitiCicliMax(k))
                  Call CalcolaPresenze(k,aLimitiCicliMin(k),aLimitiCicliMax(k),CollAmbi,abRuote)
               End If
            Next
            nInizioTmp = aLimitiCicliMax(nCicliTrovati) + 1
            Call Messaggio("Conteggio presenze nel ciclo finale incompleto")
            Call CalcolaPresenze(0,nInizioTmp,nFineRangeAnalisi,CollAmbi,abRuote)
            Call creaOutputRangeCicli(aLimitiCicliMin,aLimitiCicliMax,nCapogioco,aRuote,nFineRangeAnalisi)
         End If
      Next


      Call CreaOutputPresenzeAmbi(CollAmbi,abCicliDaCalcolare)
   End If
End Sub
Function ScegliCicliDaCalcolare(aLimitiCicliMin,aLimitiCicliMax,abCicliDaCalcolare,nCapogioco)
   Dim k
   ReDim aVoci(UBound(abCicliDaCalcolare) - 1)
   ReDim abSelected(UBound(abCicliDaCalcolare) - 1)
   For k = 0 To UBound(aVoci)
      aVoci(k) = "Ciclo " & FormatSpace(k + 1,4,True) & " da " & FormatSpace(aLimitiCicliMin(k + 1),5,2) & " a " & FormatSpace(aLimitiCicliMax(k + 1),5,2)
   Next
   If ScegliDaLista(aVoci,abSelected,"Cicli del capogioco " & nCapogioco) > 0 Then
      For k = 0 To UBound(abSelected)
         abCicliDaCalcolare(k + 1) = abSelected(k)
      Next
      ScegliCicliDaCalcolare = True
   Else
      ScegliCicliDaCalcolare = False
   End If
End Function
Sub GestioneAutomaticaRuotaTutte(aRuote,aBRuote,nRuoteSel)
   Dim k
   If aBRuote(11) Then
      ReDim aRuote(11)
      ReDim aBRuote(11)
      For k = 1 To 10
         aBRuote(k) = True
         aRuote(k) = k
      Next
   ElseIf aBRuote(12) Then
      MsgBox "Lo script non opera sulla nazionale",vbExclamation
      nRuoteSel = 0
   End If
End Sub
Sub AlimentaCollAmbi(CollAmbi,nCapogioco)
   Dim k
   Dim clsA
   For k = 1 To 90
      If k <> nCapogioco Then
         Set clsA = New clsAmbo
         Call clsA.SetAmbo(nCapogioco,k)
         clsA.Capogioco = nCapogioco
         CollAmbi.Add clsA
      End If
   Next
End Sub
Function CalcolaCicloPratico(Inizio,retInizio,retFine,nCapogioco,aBRuote,estrazioniTotali)
   Dim clsA
   Dim idEstr
   Dim r,e,N
   ReDim aBNum(90)
   Dim nTrovati
   idEstr = Inizio
   retInizio = Inizio
   If idEstr <= estrazioniTotali Then
      Do
         For r = 1 To 10
            If aBRuote(r) Then
               If IsNumeroPresenteInEstrazione(idEstr,r,nCapogioco,0) Then
                  For e = 1 To 5
                     N = Estratto(idEstr,r,e)
                     If aBNum(N) = False Then
                        aBNum(N) = True
                        nTrovati = nTrovati + 1
                     End If
                  Next
               End If
            End If
         Next
         Call AvanzamentoElab(1,90,nTrovati)
         idEstr = idEstr + 1
         If idEstr > estrazioniTotali Then Exit Do
         If ScriptInterrotto Then Exit Do
      Loop While nTrovati < 90
      retFine = idEstr - 1
      If nTrovati >= 90 Then
         CalcolaCicloPratico = True
      Else
         CalcolaCicloPratico = False
      End If
   End If
End Function
Function GetRuote(aRuote)
   Dim k
   Dim s
   For k = 1 To UBound(aRuote)
      If aRuote(k) > 0 Then
         s = s & NomeRuota(aRuote(k)) & "-"
      End If
   Next
   If Len(s) > 1 Then
      GetRuote = Left(s,Len(s) - 1)
   Else
      GetRuote = s
   End If
End Function
Sub creaOutputRangeCicli(aLimitiCicloMin,aLimitiCicloMax,nCapogioco,aRuote,nFineRangeAnalisi)
   Dim k
   Dim s
   Dim nPresenze
   ReDim aNum(1)
   aNum(1) = nCapogioco
   Call Scrivi("Cicli pratici per ambo con capogioco " & nCapogioco)
   Call Scrivi("Ruote " & GetRuote(aRuote))
   Call Scrivi
   For k = 1 To UBound(aLimitiCicloMin)
      Call StatisticaFormazione(aNum,aRuote,1,0,0,0,nPresenze,aLimitiCicloMin(k),aLimitiCicloMax(k))
      s = "Ciclo            " & FormatSpace(k,5,True) & " -->  " & _
      FormatSpace(aLimitiCicloMin(k),8,True) & " - " & FormatSpace(aLimitiCicloMax(k),8,True) & _
      " pres capogioco " & FormatSpace(nPresenze,5,True)
      Call Scrivi(s)
   Next
   Call StatisticaFormazione(aNum,aRuote,1,0,0,0,nPresenze,aLimitiCicloMax(UBound(aLimitiCicloMax)) + 1,nFineRangeAnalisi)
   s = "Ciclo incompleto " & FormatSpace(k,5,True) & " -->  " & _
   FormatSpace(aLimitiCicloMax(UBound(aLimitiCicloMax)) + 1,8,True) & " - " & FormatSpace(nFineRangeAnalisi,8,True) & _
   " pres capogioco " & FormatSpace(nPresenze,5,True)
   Call Scrivi(s)
   Call Scrivi
End Sub
Sub CalcolaPresenze(idCiclo,Inizio,Fine,collAmbi,aBRuote)
   Dim clsA
   Dim k,r,e,p
   Dim nAmbiTot,nLetti
   nAmbiTot = collAmbi.count
   For Each clsA In collAmbi
      For k = Inizio To Fine
         For r = 1 To 10
            If aBRuote(r) Then
               p = 0
               For e = 1 To 5
                  If clsA.abNum(Estratto(k,r,e)) Then
                     p = p + 1
                  End If
               Next
               If p = 2 Then
                  If idCiclo > 0 Then
                     clsA.PresPerCicliPratici(idCiclo) = clsA.PresPerCicliPratici(idCiclo) + 1
                  Else
                     clsA.PresenzeAttuali = clsA.PresenzeAttuali + 1
                  End If
               End If
            End If
         Next
      Next
      nLetti = nLetti + 1
      Call AvanzamentoElab(1,nAmbiTot,nLetti)
      If ScriptInterrotto Then Exit For
   Next
End Sub
Function ContaValoriTrue(aB)
   Dim k,n
   For k = LBound(aB) To UBound(aB)
      If aB(k) Then n = n + 1
   Next
   ContaValoriTrue = n
End Function
Sub CreaOutputPresenzeAmbi(CollAmbi,aBCicliDaCalcolare)
   Dim clsA
   Dim nColonne
   Dim k,i
   Dim nIdColSomma,nIdColPresAtt
   Dim nCicliDaCalcolare
   Dim nCicliTot
   nCicliTot = UBound(aBCicliDaCalcolare)
   nCicliDaCalcolare = ContaValoriTrue(aBCicliDaCalcolare)
   nColonne = 1 + nCicliDaCalcolare + 1 + 1
   nIdColSomma = nColonne
   nIdColPresAtt = nIdColSomma - 1
   ReDim aTitoli(nColonne)
   i = 1
   aTitoli(i) = "Ambo"
   For k = 1 To nCicliTot
      If aBCicliDaCalcolare(k) Then
         i = i + 1
         aTitoli(i) = "Freq C" & k
      End If
   Next
   aTitoli(nIdColPresAtt) = "Presenze Attuali"
   aTitoli(nIdColSomma) = "Somma"
   Call InitTabella(aTitoli,vbYellow)
   For Each clsA In CollAmbi
      ReDim aValori(nColonne)
      i = 1
      aValori(i) = clsA.GetNumeriString
      For k = 1 To nCicliTot
         If aBCicliDaCalcolare(k) Then
            i = i + 1
            aValori(i) = clsA.PresPerCicliPratici(k)
         End If
      Next
      aValori(nIdColPresAtt) = clsA.PresenzeAttuali
      aValori(nIdColSomma) = clsA.GetSommaPresenze
      Call AddRigaTabella(aValori)
   Next
   Call CreaTabella(nIdColSomma,1) 'ordina per somma  crescente
End Sub

Buon studio.
Ciao.

 

[vincenzo4221]

Grazie Druid, sei stato gentilissimo...vedo che anche tu..hai scaricato qualcosa nel tempo....hai gli altri script?

 

[druid]

No, mi spiace, solo quello.....
Ciao