Lanfranco60
Super Member >GOLD<
Giusto, per copiare modi + semplificativi io la avrei fatta cosi.
Ciao Mike, mi sono ricopiato lo script, grazie, mi servirà per fare le sose sempre migliori
Follow along with the video below to see how to install our site as a web app on your home screen.
Nota: This feature may not be available in some browsers.
X LuigiB Lente capricciosa
- Creatore Discussione Lanfranco60
- Data di inizio
Lanfranco60
Super Member >GOLD<
ATTENZIONE ancora ad una cosa, la separazione visiva delle ruote "in tabella" non è la separazione delle ruote.
Lo script che ho proposto e così strutturato assomiglia a quanto ha proposto Lanfranco ed è in Spaziometria.
Simula la visualizzazione-Estesa in cui la ricerca delle figure è come in Spaziometria, non ha confine di ruota.
Ed anche la coppia di numeri ad indice X +/- 1 ... può considerare 2 numeri a cavallo di 2 ruote diverse.
E... questo, non ben specificato ... ritengo sia diverso da quanto voluto.
In sintesi se è così ... lo script che ho proposto non va bene.
Ciao Joe, puoi spiegarmi meglio cosa intendi, perchè non mi è chiaro del tutto.
Il tuo script andava benissimo per le mie esigenze, io lo fatta più colorata, ma è un fatto puramente estetico....
Infatti io NON voglio evidenziare combinazioni a cavallo fra due ruote.
Ma allora quello che ho fatto non va bene ?
Mike58
Advanced Member >PLATINUM PLUS<
Oppure con l'amico blackmore la avremmo fatta anche cosi.
Chiaro ci possono essere tante varianti.... studiaci su.
Chiaro ci possono essere tante varianti.... studiaci su.
Codice:
Sub Main()
T = "***** CERCA SOMMA A SCELTA BY BLACKMORE & MIKE58 *****"
Call Scrivi(T,True,,RGB(128,64,0),5,5):Scrivi
ss = CInt(InputBox("SCEGLI LA SOMMA DA CERCARE","SOMMA",90))
DD = CInt(InputBox("SCEGLI LA SOMMA DA CERCARE","SOMMA",36))
ii = InputBox("SCEGLI L' ESTRAZIONE DA CONTROLLARE",,8736)
Ini = ii
fin = EstrazioneFin
ReDim title(8)
title(1) = " Data "
title(2) = " Ruota "
'title(3) = " Estratti Ruota "
title(4) = " 1°E "
title(5) = " 2°E "
title(6) = " 3°E "
title(7) = " 4°E "
title(8) = " 5°E "
Call InitTabella(title,RGB(128,64,0),,3,5)
Call Scrivi("SOMMA CERCATA : " & SS,True,True,RGB(223,0,223),5,4)
Call Scrivi("SOMMA CERCATA : " & DD,True,True,RGB(62,221,230),5,4)
Scrivi:Scrivi
For r = 1 To 12
For es = fin To Ini Step - 1
Tot = fin - Ini
c = c + 1
If r = 11 Then r = 12
n1 = Estratto(es,r,1)
n2 = Estratto(es,r,2)
n3 = Estratto(es,r,3)
n4 = Estratto(es,r,4)
n5 = Estratto(es,r,5)
Call AvanzamentoElab(Ini,fin,es)
ReDim Value(8)
Value(1) = DataEstrazione(es)
Value(2) = NomeRuota(r)
'Value(3) = StringaEstratti(es,r)
Value(4) = n1
Value(5) = n2
Value(6) = n3
Value(7) = n4
Value(8) = n5
Call AddRigaTabella(Value,,,3,,1)
Call SetColoreCella(1,RGB(251,251,255))
Call SetColoreCella(2,RGB(251,251,255))
Call SetColoreCella(3,RGB(251,251,255))
Call SetColoreCella(4,vbYellow)
Call SetColoreCella(5,vbYellow)
Call SetColoreCella(6,vbYellow)
Call SetColoreCella(7,vbYellow)
Call SetColoreCella(8,vbYellow)
Call SetColoreCella(9,RGB(239,239,239))
For y = 4 To 7
For yy = y + 1 To 8
If Value(y) + Value(yy) = Fuori90(ss) Then Call SetColoreCella((y),RGB(223,0,223),5)
If Value(yy) + Value(y) = Fuori90(ss) Then Call SetColoreCella((yy),RGB(223,0,223),5)
If Value(y) + Value(yy) =(dd) Then Call SetColoreCella((y),RGB(62,221,230),5)
If Value(yy) + Value(y) =(dd) Then Call SetColoreCella((yy),RGB(62,221,230),5)
Next
Next
Next
If ScriptInterrotto Then Exit For
ReDim agg(8)
Call AddRigaTabella(agg,3,,1,,1)
Next
Call CreaTabella(0,0,1,0,0)
End SubLanfranco60
Super Member >GOLD<
Bella anche questa, ma la voglio come il tabellone estrazionale, comincio ad avere un idea
di come fare le tabelle
e devo solo ringraziare tutti voi
di come fare le tabelle
e devo solo ringraziare tutti voi
Lanfranco60
Super Member >GOLD<
Originariamente inviato da Joe91
ATTENZIONE ancora ad una cosa, la separazione visiva delle ruote "in tabella" non è la separazione delle ruote.
Lo script che ho proposto e così strutturato assomiglia a quanto ha proposto Lanfranco ed è in Spaziometria.
Simula la visualizzazione-Estesa in cui la ricerca delle figure è come in Spaziometria, non ha confine di ruota.
Ed anche la coppia di numeri ad indice X +/- 1 ... può considerare 2 numeri a cavallo di 2 ruote diverse.
E... questo, non ben specificato ... ritengo sia diverso da quanto voluto.
In sintesi se è così ... lo script che ho proposto non va bene.
Ciao Joe, puoi spiegarmi meglio cosa intendi, perchè non mi è chiaro del tutto.
Il tuo script andava benissimo per le mie esigenze, io lo fatta più colorata, ma è un fatto puramente estetico....
Infatti io NON voglio evidenziare combinazioni a cavallo fra due ruote.
Ma allora quello che ho fatto non va bene ?
Ho fatto una prova ed è come dici tu, e così non va bene, come si può risolvere questo problema ?
grazie
ATTENZIONE ancora ad una cosa, la separazione visiva delle ruote "in tabella" non è la separazione delle ruote.
Lo script che ho proposto e così strutturato assomiglia a quanto ha proposto Lanfranco ed è in Spaziometria.
Simula la visualizzazione-Estesa in cui la ricerca delle figure è come in Spaziometria, non ha confine di ruota.
Ed anche la coppia di numeri ad indice X +/- 1 ... può considerare 2 numeri a cavallo di 2 ruote diverse.
E... questo, non ben specificato ... ritengo sia diverso da quanto voluto.
In sintesi se è così ... lo script che ho proposto non va bene.
Ciao Joe, puoi spiegarmi meglio cosa intendi, perchè non mi è chiaro del tutto.
Il tuo script andava benissimo per le mie esigenze, io lo fatta più colorata, ma è un fatto puramente estetico....
Infatti io NON voglio evidenziare combinazioni a cavallo fra due ruote.
Ma allora quello che ho fatto non va bene ?
Ho fatto una prova ed è come dici tu, e così non va bene, come si può risolvere questo problema ?
grazie
Lanfranco60
Super Member >GOLD<
Ormai le tabelle a grandi linee le ho capite, rimane il fatto che devo trovare un escamotage script per arginare il fatto della combinazione da NON evidenziare a cavallo tra 2 ruote.
Grazie Joe
Grazie Joe
Joe91
Advanced Member >PLATINUM PLUS<
Ciao Lanfranco.
Ok ...
Ma avendo trattato un pò di script diversi dovrei sapere quale utilizzerai, per fare la tabella ...
ed io, farci, qualche prova, prima di consigliarti una soluzione.
In pratica una l'avrei trovata ... ma non so se si adatta allo scopo,
perchè è concettualmente molto-molto diversa dalla precedente che dici non andare bene.
Fammi sapere.
Ok ...
Ma avendo trattato un pò di script diversi dovrei sapere quale utilizzerai, per fare la tabella ...
ed io, farci, qualche prova, prima di consigliarti una soluzione.
In pratica una l'avrei trovata ... ma non so se si adatta allo scopo,
perchè è concettualmente molto-molto diversa dalla precedente che dici non andare bene.
Fammi sapere.
Rosanna
Super Member >PLATINUM<
Ciao tutti...
siccome anche io sono pressochè a digiuno delle varie istruzioni sulla costruzione di tabelle in output con SpazioMetria, mi sono riletta la discussione.
L'approccio finora utilizzato prevede una colonna per stringaestratti e questo va bene per fare esercizio ma se poi si deve evidenziare una particolare combinazione di num, l'approccio di Joe mi sembra più corretto anche se va studiato un trucco per ottenere una evidenziazione "a ruota".
Tornando alla costruzione del tabellone estratti.. incuriosita ci ho provato anche io.
Ho letto nelle note dell'help che :
per cui al momento ho previsto solo 5colonne per ciascuna delle 10 ruote ed infilato la data sull'ultima colonna la 51esima.
Onestamente questa nota non l'ho capita perchè ho provato a colorare di grigio la 51esima colonna con le date e funziona. Boh...??
Per i titoli ho avuto il primo problema ovvero come faccio a mettere la ruota sulle sue 5 colonne? Esiste una funzione tipo "unisci celle"?
Al momento non ho trovato di meglio che intitolare le posizioni e aggiungere una minitabella fatta di soli titoli per le ruote...
Speravo risultasse appiccicata al tabellone invece c'è uno spazio notevole (per capire meglio fate prima a far girare lo script)
Altra cosa...... che proprio non ho capito:
ho provato a evidenziare le celle contenenti un dato valore. Dovrebbe essere una banalità ma non va.
Ho messo un ciclo for next per scorrere le 50 celle della riga in esame, ma SetColoreCella sembra non accettare il nome della variabile. Se sostituisco
la variabil con l'id cella... lo script gira anche se non funzia lo stesso. Si comporta in modo strano...
Se riuscite a vedere l'errore che non vedo.. o avete suggerimenti.. sono ben accetti.
Trovato il motivo!! La variabile va inserita in parentesi..
Risolto problema e corretto script alla voce SetColoreCella!
siccome anche io sono pressochè a digiuno delle varie istruzioni sulla costruzione di tabelle in output con SpazioMetria, mi sono riletta la discussione.
L'approccio finora utilizzato prevede una colonna per stringaestratti e questo va bene per fare esercizio ma se poi si deve evidenziare una particolare combinazione di num, l'approccio di Joe mi sembra più corretto anche se va studiato un trucco per ottenere una evidenziazione "a ruota".
Tornando alla costruzione del tabellone estratti.. incuriosita ci ho provato anche io.
Ho letto nelle note dell'help che :
per cui al momento ho previsto solo 5colonne per ciascuna delle 10 ruote ed infilato la data sull'ultima colonna la 51esima.
Onestamente questa nota non l'ho capita perchè ho provato a colorare di grigio la 51esima colonna con le date e funziona. Boh...??
Per i titoli ho avuto il primo problema ovvero come faccio a mettere la ruota sulle sue 5 colonne? Esiste una funzione tipo "unisci celle"?
Al momento non ho trovato di meglio che intitolare le posizioni e aggiungere una minitabella fatta di soli titoli per le ruote...
Speravo risultasse appiccicata al tabellone invece c'è uno spazio notevole (per capire meglio fate prima a far girare lo script)
Altra cosa...... che proprio non ho capito:
ho provato a evidenziare le celle contenenti un dato valore. Dovrebbe essere una banalità ma non va.
Ho messo un ciclo for next per scorrere le 50 celle della riga in esame, ma SetColoreCella sembra non accettare il nome della variabile. Se sostituisco
la variabil con l'id cella... lo script gira anche se non funzia lo stesso. Si comporta in modo strano...
Se riuscite a vedere l'errore che non vedo.. o avete suggerimenti.. sono ben accetti.
Trovato il motivo!! La variabile va inserita in parentesi..
Codice:
Option Explicit
Sub Main
'0904_21b Rosanna prova tabella estratti.ls
Dim idEstr,Inizio,Fine,nAnalisi
Dim r,p,i,co,z
Dim aTitoli(51),tit(10)
Dim aValori(51)
nAnalisi = CInt(InputBox(" Di quante estrazioni vuoi il tabellone ? ",,"15"))
Inizio = EstrazioneFin - nAnalisi + 1
Fine = EstrazioneFin
z = 2 : z = CInt(z) '<====== ATTENZIONE PROVA - NUMERO CHE VORREI EVIDENZIARE SUL TABELLONE!!
'-----------------------
co = 0
For r = 1 To 10
tit(r) = Space(12) & SiglaRuota(r) & Space(11)
For p = 1 To 5
co = co + 1
aTitoli(co) = p
Next
Next
aTitoli(51) = "data"
Call InitTabella(tit,RGB(207,207,207),"center",1,0)
CreaTabella
Call InitTabella(aTitoli,RGB(207,207,207),"center",1,0)
'----------------------------------------
For idEstr = Inizio To Fine
aValori(51) = DataEstrazione(idEstr) ' sull'ultima colonna metto la data
co = 0
For r = 1 To 10
For p = 1 To 5
co = co + 1
aValori(co) = Estratto(idEstr,r,p)
Next
Next
Call AddRigaTabella(aValori,5,"right",1,0) '5=bianco
Call SetColoreCella(51,RGB(207,207,207)) ' la 51esima colonna viene colorata nonostante le note sull'help. boh?!
'--------------------------------------------evidenzio un dato valore
For i = 1 To 50
If aValori(i)=z Then Call SetColoreCella((i),vbYellow,0)
Next
'-----------------------------------------------------------------------
Next
Call CreaTabella
End SubRisolto problema e corretto script alla voce SetColoreCella!
Ultima modifica:
Joe91
Advanced Member >PLATINUM PLUS<
|01.06.2013|90.33.31.66.79|37.27.80.62.77|06.87.67.28.48|58.47.16.13.38|49.39.33.82.66|85.50.38.46.42|44.39.35.55.38|03.04.31.62.83|12.45.44.22.82|20.26.15.84.11|33.62.86.70.41|
|04.06.2013|59.81.29.08.62|41.51.20.02.73|61.19.17.02.35|83.56.51.41.05|71.51.16.59.03|65.11.50.43.54|56.79.62.40.01|59.87.78.25.14|14.19.05.77.46|12.10.02.24.43|70.44.04.58.86|
|06.06.2013|55.47.83.18.24|13.22.19.10.54|42.67.59.77.30|76.57.68.07.78|78.11.76.59.37|61.84.48.90.45|31.87.04.27.33|02.12.04.51.62|56.63.88.53.68|17.69.83.06.34|61.36.75.09.85|
|08.06.2013|27.87.76.37.69|02.43.56.26.60|36.29.59.13.65|63.26.29.59.28|48.46.87.25.01|22.80.09.45.77|52.33.11.78.62|73.86.25.21.63|09.63.28.74.79|45.68.69.89.83|41.18.50.20.87|
|11.06.2013|07.60.90.55.34|64.19.47.23.62|58.63.69.40.60|56.21.83.25.26|37.69.82.38.79|16.87.70.40.11|13.69.25.60.33|80.14.21.62.58|48.05.76.03.74|23.87.68.53.16|41.60.13.64.25|
|13.06.2013|59.79.49.75.05|39.17.04.86.34|69.80.85.02.33|78.77.86.59.83|48.64.36.33.20|60.61.06.51.17|06.84.53.62.30|23.24.52.10.65|69.17.84.68.31|43.13.01.30.56|64.74.68.77.40|
|15.06.2013|06.58.07.74.51|49.08.19.89.06|61.17.45.59.39|61.78.07.63.51|56.40.90.86.53|13.68.43.75.67|89.59.67.11.85|90.08.85.36.59|43.78.17.40.31|63.84.13.65.36|40.38.56.20.05|
|18.06.2013|01.47.07.09.20|15.53.57.18.35|04.06.30.88.10|09.30.35.74.07|14.02.58.57.71|74.29.65.01.22|38.76.58.83.60|24.39.19.73.46|01.04.89.07.10|28.23.60.39.40|32.16.06.52.80|
|20.06.2013|54.36.01.77.28|12.30.58.70.64|30.44.52.79.71|19.83.10.36.89|15.67.48.09.12|42.06.50.58.18|42.78.65.62.26|26.30.45.75.83|32.65.74.80.43|26.40.84.07.78|37.80.79.77.42|
|22.06.2013|41.82.51.56.72|87.80.64.88.40|53.73.11.36.06|29.82.31.06.63|18.75.01.30.28|29.75.70.43.80|08.86.18.66.14|61.79.42.84.89|29.09.49.39.02|25.45.65.18.29|01.82.23.43.40|
|25.06.2013|18.89.79.53.55|70.66.79.21.90|65.46.51.20.74|68.83.30.43.76|32.56.22.29.28|32.78.75.02.69|03.20.83.44.82|70.04.52.55.07|61.50.40.11.81|86.59.80.29.83|47.80.27.32.57|
|27.06.2013|38.81.12.03.78|15.25.04.12.31|11.35.05.79.40|63.33.47.61.19|76.35.15.82.16|45.78.21.15.13|24.46.72.57.40|84.21.38.90.64|68.27.86.47.85|75.69.31.86.60|22.42.26.08.34|
|29.06.2013|45.14.67.12.41|79.09.73.19.47|54.68.65.50.70|34.39.80.54.56|58.26.41.59.86|72.35.68.38.19|26.50.15.85.46|45.90.31.02.76|47.34.26.81.03|47.84.86.19.90|69.29.50.46.06|
|02.07.2013|66.07.81.49.50|89.51.77.56.01|61.86.02.22.70|80.12.64.56.70|15.55.24.27.49|04.74.53.23.63|08.07.68.69.30|33.43.14.01.47|57.41.22.59.84|18.56.33.32.31|72.75.30.39.48|
|04.07.2013|81.05.71.43.61|57.63.05.42.85|41.18.66.80.68|84.38.78.42.76|34.67.01.56.51|89.82.63.40.37|06.16.14.76.84|06.30.29.22.44|51.05.48.25.84|83.57.74.66.36|51.10.52.47.35|
|06.07.2013|87.49.03.46.81|57.78.82.28.01|41.56.76.51.74|41.48.08.51.74|34.77.41.05.55|73.11.38.53.17|16.66.57.50.40|46.60.55.71.33|84.31.33.45.27|23.48.03.42.02|89.61.52.48.58|
|09.07.2013|68.21.23.59.24|21.50.67.38.48|74.37.10.86.84|48.17.78.29.73|14.04.07.78.51|85.53.78.62.64|23.89.14.12.62|24.36.72.64.81|26.78.23.59.49|66.56.70.38.72|15.66.26.51.25|
|11.07.2013|19.24.07.66.88|32.81.36.53.88|84.73.33.42.86|29.72.65.49.52|54.38.48.12.65|19.70.53.03.89|23.13.37.30.42|49.42.25.17.08|73.16.26.48.42|27.08.43.32.89|15.58.65.04.63|
|13.07.2013|68.49.05.26.46|63.28.44.34.45|70.24.46.19.84|51.76.33.48.86|15.28.58.80.26|11.77.69.38.33|37.78.28.45.27|89.60.14.85.62|11.51.03.18.20|22.31.43.41.48|31.69.23.61.81|
|16.07.2013|81.27.51.20.70|04.06.83.57.65|83.52.16.68.08|77.37.79.71.90|31.05.75.44.89|52.08.18.46.34|59.35.18.74.55|78.24.89.54.55|13.20.58.36.90|36.60.78.31.30|84.02.23.49.69|
|18.07.2013|57.68.85.53.63|76.39.60.73.01|80.05.23.46.40|24.12.45.44.83|28.20.14.80.32|59.56.38.34.73|79.15.04.84.61|22.88.15.05.10|79.26.25.31.42|44.60.87.80.12|53.76.68.41.82|
|20.07.2013|54.53.83.79.47|03.54.06.55.31|44.86.50.07.04|47.29.72.31.43|14.51.71.30.82|19.73.60.80.31|65.16.83.22.11|42.50.13.33.80|76.22.47.40.52|17.55.90.54.41|54.72.13.11.46|
|23.07.2013|41.08.33.54.35|47.34.02.46.32|58.04.08.83.13|15.34.05.49.20|49.56.29.70.78|23.60.85.04.88|10.67.90.69.68|11.72.08.23.39|52.16.38.34.87|75.83.54.61.34|88.57.52.25.35|
|25.07.2013|71.21.63.17.42|38.90.73.72.50|81.88.37.16.30|45.50.37.56.07|82.43.66.06.75|73.06.77.89.50|30.24.34.79.10|01.27.55.84.11|18.43.87.84.75|43.61.73.22.15|07.06.64.43.48|
|27.07.2013|09.88.46.36.58|47.09.79.56.15|60.26.04.44.70|42.60.75.05.13|18.01.32.39.04|53.01.32.45.74|29.17.10.66.68|68.66.47.07.73|21.17.72.42.47|01.10.66.18.88|07.15.33.78.28|
|30.07.2013|29.07.69.17.50|14.78.18.56.58|63.01.35.66.77|25.87.83.27.49|50.73.09.33.11|34.56.75.39.60|20.51.25.29.68|15.40.32.47.87|25.60.34.30.61|33.81.73.40.14|07.49.90.12.46|
|01.08.2013|41.31.21.77.72|70.46.48.02.87|39.86.28.31.02|13.78.03.60.62|35.21.32.83.29|49.75.34.65.89|22.60.65.23.02|79.48.78.88.90|71.40.13.55.03|11.60.46.23.10|79.19.82.36.10|
|03.08.2013|11.01.40.43.76|49.02.73.66.20|26.12.17.45.54|40.30.07.87.51|30.10.51.86.21|62.15.13.77.25|02.89.90.65.46|69.81.71.82.34|04.51.26.14.76|03.28.47.18.79|07.23.09.08.49|
|06.08.2013|52.57.69.76.53|14.09.88.89.40|63.44.45.90.35|37.02.35.22.56|22.54.19.20.01|61.74.40.83.39|49.11.02.25.66|05.40.22.72.02|41.88.89.73.56|77.74.48.72.51|73.03.15.28.64|
|08.08.2013|23.57.64.74.04|24.74.28.82.40|55.53.27.56.62|25.13.01.77.88|39.64.47.81.76|22.07.80.17.82|05.56.89.62.29|51.79.45.27.37|04.42.09.61.73|67.08.55.84.23|79.74.84.25.47|
|10.08.2013|52.86.10.90.06|63.90.54.60.88|27.31.30.11.35|88.06.71.18.34|52.58.59.25.49|18.67.13.85.28|74.28.07.71.88|48.69.86.51.22|68.87.07.51.32|55.48.84.43.35|88.14.32.84.40|
|13.08.2013|81.86.56.06.39|23.63.46.09.73|33.43.21.64.88|49.11.12.41.02|80.87.03.50.54|35.79.48.29.33|32.64.25.48.71|17.85.07.05.63|82.28.09.06.08|07.40.44.88.78|37.85.68.02.61|
|16.08.2013|06.82.60.73.70|48.34.08.83.54|44.35.86.19.07|11.10.51.03.83|37.17.39.59.49|09.05.32.84.68|50.87.59.09.55|52.17.62.56.82|55.83.59.46.50|04.33.87.06.05|34.25.43.87.36|
|17.08.2013|47.56.07.74.58|86.02.30.40.75|72.64.41.81.80|51.26.43.61.32|31.62.32.25.75|60.83.18.35.05|29.08.47.12.69|18.37.67.45.32|27.58.36.82.81|10.76.80.29.60|29.23.55.71.77|
|20.08.2013|09.05.62.01.69|27.90.51.85.21|63.69.68.14.61|61.05.40.76.60|47.20.29.26.55|37.58.21.41.54|52.73.08.11.61|77.15.02.58.78|38.23.65.40.41|76.61.04.32.56|67.23.32.20.89|
|22.08.2013|65.41.35.75.13|88.68.46.71.01|81.43.04.22.90|29.67.69.34.03|16.89.33.42.08|74.28.62.83.27|24.69.35.04.46|83.78.24.47.41|27.52.51.31.10|20.61.32.80.74|89.87.68.84.38|
|24.08.2013|52.71.21.89.23|56.01.68.17.87|08.82.37.29.57|14.85.17.24.90|87.41.42.19.16|73.01.83.79.51|22.26.10.14.83|09.74.23.67.83|76.14.50.89.73|83.78.11.06.09|32.56.68.58.34|
|27.08.2013|41.17.11.62.08|66.11.27.72.30|48.20.14.28.15|83.16.80.25.87|64.02.07.08.29|08.41.54.15.42|29.47.42.44.73|15.03.84.16.71|49.38.12.63.86|20.45.56.08.66|68.03.19.14.64|
|29.08.2013|59.72.87.48.24|28.79.14.86.24|47.50.55.10.08|19.12.74.13.48|84.10.50.56.17|87.41.16.60.38|32.08.52.83.27|26.66.15.16.36|59.55.03.66.05|82.27.40.08.86|36.24.71.59.77|
|31.08.2013|64.84.12.63.15|43.20.19.73.55|25.15.05.19.10|75.56.09.33.78|85.88.18.56.50|75.64.45.48.46|48.63.49.90.57|64.81.68.62.40|44.35.27.37.33|46.18.50.44.82|31.49.47.16.33|
|03.09.2013|58.06.68.80.31|04.58.21.62.48|16.17.87.85.71|50.31.18.13.52|32.55.39.47.34|23.77.26.58.52|80.54.86.04.38|04.06.88.43.61|04.38.15.66.06|26.34.44.68.37|50.40.78.46.17|
|05.09.2013|09.05.65.44.10|56.77.90.87.28|05.76.37.90.84|36.78.08.15.23|55.71.16.15.46|43.24.47.49.05|57.81.51.67.50|28.64.25.89.27|36.38.73.72.81|76.89.33.35.18|15.66.39.14.30|
|07.09.2013|33.26.57.24.80|68.66.21.24.90|24.46.59.27.69|10.84.88.70.02|79.24.14.88.78|69.53.52.40.36|89.67.18.41.13|35.73.27.43.39|58.34.71.48.73|41.66.50.12.56|53.60.58.73.16|
|10.09.2013|04.69.29.60.45|24.16.80.58.55|22.11.67.90.51|43.67.54.19.63|61.10.41.25.33|47.25.20.51.03|27.43.69.89.09|76.27.48.88.39|56.48.89.09.88|46.30.09.19.45|90.13.33.62.44|
|12.09.2013|16.80.02.34.60|90.02.76.83.31|86.39.40.87.42|22.34.61.62.36|61.25.43.47.22|46.17.61.12.76|17.75.50.45.60|80.55.13.14.31|57.20.48.25.59|86.32.60.76.04|69.89.57.60.72|
|04.06.2013|59.81.29.08.62|41.51.20.02.73|61.19.17.02.35|83.56.51.41.05|71.51.16.59.03|65.11.50.43.54|56.79.62.40.01|59.87.78.25.14|14.19.05.77.46|12.10.02.24.43|70.44.04.58.86|
|06.06.2013|55.47.83.18.24|13.22.19.10.54|42.67.59.77.30|76.57.68.07.78|78.11.76.59.37|61.84.48.90.45|31.87.04.27.33|02.12.04.51.62|56.63.88.53.68|17.69.83.06.34|61.36.75.09.85|
|08.06.2013|27.87.76.37.69|02.43.56.26.60|36.29.59.13.65|63.26.29.59.28|48.46.87.25.01|22.80.09.45.77|52.33.11.78.62|73.86.25.21.63|09.63.28.74.79|45.68.69.89.83|41.18.50.20.87|
|11.06.2013|07.60.90.55.34|64.19.47.23.62|58.63.69.40.60|56.21.83.25.26|37.69.82.38.79|16.87.70.40.11|13.69.25.60.33|80.14.21.62.58|48.05.76.03.74|23.87.68.53.16|41.60.13.64.25|
|13.06.2013|59.79.49.75.05|39.17.04.86.34|69.80.85.02.33|78.77.86.59.83|48.64.36.33.20|60.61.06.51.17|06.84.53.62.30|23.24.52.10.65|69.17.84.68.31|43.13.01.30.56|64.74.68.77.40|
|15.06.2013|06.58.07.74.51|49.08.19.89.06|61.17.45.59.39|61.78.07.63.51|56.40.90.86.53|13.68.43.75.67|89.59.67.11.85|90.08.85.36.59|43.78.17.40.31|63.84.13.65.36|40.38.56.20.05|
|18.06.2013|01.47.07.09.20|15.53.57.18.35|04.06.30.88.10|09.30.35.74.07|14.02.58.57.71|74.29.65.01.22|38.76.58.83.60|24.39.19.73.46|01.04.89.07.10|28.23.60.39.40|32.16.06.52.80|
|20.06.2013|54.36.01.77.28|12.30.58.70.64|30.44.52.79.71|19.83.10.36.89|15.67.48.09.12|42.06.50.58.18|42.78.65.62.26|26.30.45.75.83|32.65.74.80.43|26.40.84.07.78|37.80.79.77.42|
|22.06.2013|41.82.51.56.72|87.80.64.88.40|53.73.11.36.06|29.82.31.06.63|18.75.01.30.28|29.75.70.43.80|08.86.18.66.14|61.79.42.84.89|29.09.49.39.02|25.45.65.18.29|01.82.23.43.40|
|25.06.2013|18.89.79.53.55|70.66.79.21.90|65.46.51.20.74|68.83.30.43.76|32.56.22.29.28|32.78.75.02.69|03.20.83.44.82|70.04.52.55.07|61.50.40.11.81|86.59.80.29.83|47.80.27.32.57|
|27.06.2013|38.81.12.03.78|15.25.04.12.31|11.35.05.79.40|63.33.47.61.19|76.35.15.82.16|45.78.21.15.13|24.46.72.57.40|84.21.38.90.64|68.27.86.47.85|75.69.31.86.60|22.42.26.08.34|
|29.06.2013|45.14.67.12.41|79.09.73.19.47|54.68.65.50.70|34.39.80.54.56|58.26.41.59.86|72.35.68.38.19|26.50.15.85.46|45.90.31.02.76|47.34.26.81.03|47.84.86.19.90|69.29.50.46.06|
|02.07.2013|66.07.81.49.50|89.51.77.56.01|61.86.02.22.70|80.12.64.56.70|15.55.24.27.49|04.74.53.23.63|08.07.68.69.30|33.43.14.01.47|57.41.22.59.84|18.56.33.32.31|72.75.30.39.48|
|04.07.2013|81.05.71.43.61|57.63.05.42.85|41.18.66.80.68|84.38.78.42.76|34.67.01.56.51|89.82.63.40.37|06.16.14.76.84|06.30.29.22.44|51.05.48.25.84|83.57.74.66.36|51.10.52.47.35|
|06.07.2013|87.49.03.46.81|57.78.82.28.01|41.56.76.51.74|41.48.08.51.74|34.77.41.05.55|73.11.38.53.17|16.66.57.50.40|46.60.55.71.33|84.31.33.45.27|23.48.03.42.02|89.61.52.48.58|
|09.07.2013|68.21.23.59.24|21.50.67.38.48|74.37.10.86.84|48.17.78.29.73|14.04.07.78.51|85.53.78.62.64|23.89.14.12.62|24.36.72.64.81|26.78.23.59.49|66.56.70.38.72|15.66.26.51.25|
|11.07.2013|19.24.07.66.88|32.81.36.53.88|84.73.33.42.86|29.72.65.49.52|54.38.48.12.65|19.70.53.03.89|23.13.37.30.42|49.42.25.17.08|73.16.26.48.42|27.08.43.32.89|15.58.65.04.63|
|13.07.2013|68.49.05.26.46|63.28.44.34.45|70.24.46.19.84|51.76.33.48.86|15.28.58.80.26|11.77.69.38.33|37.78.28.45.27|89.60.14.85.62|11.51.03.18.20|22.31.43.41.48|31.69.23.61.81|
|16.07.2013|81.27.51.20.70|04.06.83.57.65|83.52.16.68.08|77.37.79.71.90|31.05.75.44.89|52.08.18.46.34|59.35.18.74.55|78.24.89.54.55|13.20.58.36.90|36.60.78.31.30|84.02.23.49.69|
|18.07.2013|57.68.85.53.63|76.39.60.73.01|80.05.23.46.40|24.12.45.44.83|28.20.14.80.32|59.56.38.34.73|79.15.04.84.61|22.88.15.05.10|79.26.25.31.42|44.60.87.80.12|53.76.68.41.82|
|20.07.2013|54.53.83.79.47|03.54.06.55.31|44.86.50.07.04|47.29.72.31.43|14.51.71.30.82|19.73.60.80.31|65.16.83.22.11|42.50.13.33.80|76.22.47.40.52|17.55.90.54.41|54.72.13.11.46|
|23.07.2013|41.08.33.54.35|47.34.02.46.32|58.04.08.83.13|15.34.05.49.20|49.56.29.70.78|23.60.85.04.88|10.67.90.69.68|11.72.08.23.39|52.16.38.34.87|75.83.54.61.34|88.57.52.25.35|
|25.07.2013|71.21.63.17.42|38.90.73.72.50|81.88.37.16.30|45.50.37.56.07|82.43.66.06.75|73.06.77.89.50|30.24.34.79.10|01.27.55.84.11|18.43.87.84.75|43.61.73.22.15|07.06.64.43.48|
|27.07.2013|09.88.46.36.58|47.09.79.56.15|60.26.04.44.70|42.60.75.05.13|18.01.32.39.04|53.01.32.45.74|29.17.10.66.68|68.66.47.07.73|21.17.72.42.47|01.10.66.18.88|07.15.33.78.28|
|30.07.2013|29.07.69.17.50|14.78.18.56.58|63.01.35.66.77|25.87.83.27.49|50.73.09.33.11|34.56.75.39.60|20.51.25.29.68|15.40.32.47.87|25.60.34.30.61|33.81.73.40.14|07.49.90.12.46|
|01.08.2013|41.31.21.77.72|70.46.48.02.87|39.86.28.31.02|13.78.03.60.62|35.21.32.83.29|49.75.34.65.89|22.60.65.23.02|79.48.78.88.90|71.40.13.55.03|11.60.46.23.10|79.19.82.36.10|
|03.08.2013|11.01.40.43.76|49.02.73.66.20|26.12.17.45.54|40.30.07.87.51|30.10.51.86.21|62.15.13.77.25|02.89.90.65.46|69.81.71.82.34|04.51.26.14.76|03.28.47.18.79|07.23.09.08.49|
|06.08.2013|52.57.69.76.53|14.09.88.89.40|63.44.45.90.35|37.02.35.22.56|22.54.19.20.01|61.74.40.83.39|49.11.02.25.66|05.40.22.72.02|41.88.89.73.56|77.74.48.72.51|73.03.15.28.64|
|08.08.2013|23.57.64.74.04|24.74.28.82.40|55.53.27.56.62|25.13.01.77.88|39.64.47.81.76|22.07.80.17.82|05.56.89.62.29|51.79.45.27.37|04.42.09.61.73|67.08.55.84.23|79.74.84.25.47|
|10.08.2013|52.86.10.90.06|63.90.54.60.88|27.31.30.11.35|88.06.71.18.34|52.58.59.25.49|18.67.13.85.28|74.28.07.71.88|48.69.86.51.22|68.87.07.51.32|55.48.84.43.35|88.14.32.84.40|
|13.08.2013|81.86.56.06.39|23.63.46.09.73|33.43.21.64.88|49.11.12.41.02|80.87.03.50.54|35.79.48.29.33|32.64.25.48.71|17.85.07.05.63|82.28.09.06.08|07.40.44.88.78|37.85.68.02.61|
|16.08.2013|06.82.60.73.70|48.34.08.83.54|44.35.86.19.07|11.10.51.03.83|37.17.39.59.49|09.05.32.84.68|50.87.59.09.55|52.17.62.56.82|55.83.59.46.50|04.33.87.06.05|34.25.43.87.36|
|17.08.2013|47.56.07.74.58|86.02.30.40.75|72.64.41.81.80|51.26.43.61.32|31.62.32.25.75|60.83.18.35.05|29.08.47.12.69|18.37.67.45.32|27.58.36.82.81|10.76.80.29.60|29.23.55.71.77|
|20.08.2013|09.05.62.01.69|27.90.51.85.21|63.69.68.14.61|61.05.40.76.60|47.20.29.26.55|37.58.21.41.54|52.73.08.11.61|77.15.02.58.78|38.23.65.40.41|76.61.04.32.56|67.23.32.20.89|
|22.08.2013|65.41.35.75.13|88.68.46.71.01|81.43.04.22.90|29.67.69.34.03|16.89.33.42.08|74.28.62.83.27|24.69.35.04.46|83.78.24.47.41|27.52.51.31.10|20.61.32.80.74|89.87.68.84.38|
|24.08.2013|52.71.21.89.23|56.01.68.17.87|08.82.37.29.57|14.85.17.24.90|87.41.42.19.16|73.01.83.79.51|22.26.10.14.83|09.74.23.67.83|76.14.50.89.73|83.78.11.06.09|32.56.68.58.34|
|27.08.2013|41.17.11.62.08|66.11.27.72.30|48.20.14.28.15|83.16.80.25.87|64.02.07.08.29|08.41.54.15.42|29.47.42.44.73|15.03.84.16.71|49.38.12.63.86|20.45.56.08.66|68.03.19.14.64|
|29.08.2013|59.72.87.48.24|28.79.14.86.24|47.50.55.10.08|19.12.74.13.48|84.10.50.56.17|87.41.16.60.38|32.08.52.83.27|26.66.15.16.36|59.55.03.66.05|82.27.40.08.86|36.24.71.59.77|
|31.08.2013|64.84.12.63.15|43.20.19.73.55|25.15.05.19.10|75.56.09.33.78|85.88.18.56.50|75.64.45.48.46|48.63.49.90.57|64.81.68.62.40|44.35.27.37.33|46.18.50.44.82|31.49.47.16.33|
|03.09.2013|58.06.68.80.31|04.58.21.62.48|16.17.87.85.71|50.31.18.13.52|32.55.39.47.34|23.77.26.58.52|80.54.86.04.38|04.06.88.43.61|04.38.15.66.06|26.34.44.68.37|50.40.78.46.17|
|05.09.2013|09.05.65.44.10|56.77.90.87.28|05.76.37.90.84|36.78.08.15.23|55.71.16.15.46|43.24.47.49.05|57.81.51.67.50|28.64.25.89.27|36.38.73.72.81|76.89.33.35.18|15.66.39.14.30|
|07.09.2013|33.26.57.24.80|68.66.21.24.90|24.46.59.27.69|10.84.88.70.02|79.24.14.88.78|69.53.52.40.36|89.67.18.41.13|35.73.27.43.39|58.34.71.48.73|41.66.50.12.56|53.60.58.73.16|
|10.09.2013|04.69.29.60.45|24.16.80.58.55|22.11.67.90.51|43.67.54.19.63|61.10.41.25.33|47.25.20.51.03|27.43.69.89.09|76.27.48.88.39|56.48.89.09.88|46.30.09.19.45|90.13.33.62.44|
|12.09.2013|16.80.02.34.60|90.02.76.83.31|86.39.40.87.42|22.34.61.62.36|61.25.43.47.22|46.17.61.12.76|17.75.50.45.60|80.55.13.14.31|57.20.48.25.59|86.32.60.76.04|69.89.57.60.72|
Rosanna
Super Member >PLATINUM<
Questo non elegante trova gli ambi orizzontali di somma (a ruota) x sul tabellone degli estratti
Codice:
Option Explicit
Sub Main
'0904_21c Rosanna prova tabella estratti- Ricerca ambi somma.ls
Dim idEstr,Inizio,Fine,nAnalisi
Dim r,p,q,i,co,z,nPos1,nPos2
Dim aTitoli(51),tit(10)
Dim aValori(51)
nAnalisi = CInt(InputBox(" Di quante estrazioni vuoi il tabellone ? ",,"15"))
z = CInt(InputBox("Di quale somma vuoi evidenziare gli ambi orizzontali? ",,"20"))
Inizio = EstrazioneFin - nAnalisi + 1
Fine = EstrazioneFin
Scrivi "Ambi di somma "& z,1
'-----------------------
co = 0
For r = 1 To 10
tit(r) = Space(12) & SiglaRuota(r) & Space(11)
For p = 1 To 5
co = co + 1
aTitoli(co) = p
Next
Next
aTitoli(51) = "data"
Call InitTabella(tit,RGB(207,207,207),"center",1,0)
CreaTabella
Call InitTabella(aTitoli,RGB(207,207,207),"center",1,0)
'----------------------------------------
For idEstr = Inizio To Fine
aValori(51) = DataEstrazione(idEstr) ' sull'ultima colonna metto la data
co = 0
For r = 1 To 10
For p = 1 To 5
co = co + 1
aValori(co) = Estratto(idEstr,r,p)
Next
Next
Call AddRigaTabella(aValori,5,"right",1,0) '5=bianco
Call SetColoreCella(51,RGB(207,207,207)) ' la 51esima colonna viene colorata nonostante le note sull'help. boh?!
'--------------------------------------------
For r = 1 To 10
For p = 1 To 4
For q = p + 1 To 5
If Fuori90(Estratto(idEstr,r,p) + Estratto(idEstr,r,q)) = z Then
nPos1 = idPosiz(r,p)
nPos2 = idPosiz(r,q)
Call SetColoreCella((nPos1),vbYellow,0)
Call SetColoreCella((nPos2),vbYellow,0)
End If
Next
Next
Next
'-----------------------------------------------------------------------
Next
Call CreaTabella
End Sub
Function idPosiz(idRuota,IdPos)
Dim conta,r,p
conta = 0
For r = 1 To 11
If r = 11 Then r = 12
For p = 1 To 5
conta = conta + 1
If idRuota = r And IdPos = p Then idPosiz = conta
Next
Next
End Function
Ultima modifica:
L
LuigiB
Guest
ciao , ecco il mio sript ... è commentatissimo e credo facile da modificare . Nel senso che la struttura non va cambiata non è necessario basta inserire solo le nuove funzioni per la ricerca
di altre situazioni oltre a quelle gia gestite Somme e Distanze,
In pratica per modificare questo script basta capire come funzionano le funzoni CercaSomme o CercaDistanze per poi inserire una propria funzione di ricerca che usi la stessa logica di quelle proposte
gia implementate.
Ci vuole pero l'ultima versione del programma la 1.4.49
di altre situazioni oltre a quelle gia gestite Somme e Distanze,
In pratica per modificare questo script basta capire come funzionano le funzoni CercaSomme o CercaDistanze per poi inserire una propria funzione di ricerca che usi la stessa logica di quelle proposte
gia implementate.
Ci vuole pero l'ultima versione del programma la 1.4.49
Codice:
Option Explicit
Sub Main
' l'approccio di questo script è di avere in memoria attraverso un'array bidimensionale
' una griglia che contenga i numeri estratti nelle ultime N estrazioni scelte dall'utente
' su questo array agiranno tutte le funzioni di ricerca , al termine verra creata
' una tabella usando i dati presenti nell'array
' quindi in sintesi lavoreremo sempre sull'array , solo alla fine dopo tutte le elucubrazioni
' useremo i dati di questo array per creare la table
Dim nQRigheGrliglia ' righe della griglia corrsiponde al numero di estrazioni volute
Dim nInizio,nFine ' range analisi
Dim nParamCercato ' usato per chiedere all'utente il parametro del tipo di ricerca
Dim bRicercaSuRuotaSing ' usato per cercare solo su ruota e non a cavallo
Dim bRicercaInVert ' usato per abiliare la ricerca In Verticale
nQRigheGrliglia = 50 ' preimposto a 50 righe ovvero le ultime 50 estrazioni
nFine = EstrazioneFin ' faccio i calcoli per individuare il range da usare
nInizio =(nFine - nQRigheGrliglia) + 1
bRicercaSuRuotaSing = True ' abilito la ricerca solo su ruota e non a cavallo
bRicercaInVert = True ' abilito la ricerca in verticale
' preparo un array che rispecchierà le celle della griglia
' il numero di righe è a discrezione dell'utente come abbiamo visto
' le colonne sono 57 perche
' la prima è la data
' la seconda è il ritardo
' le altre a gruppi di 5 sono gli estratti delle 11 ruote
ReDim aCelle(nQRigheGrliglia,57)
' alimento l'array con i numeri estratti all'interno del range
Call AlimentaArrayCellle(aCelle,nInizio,nFine)
' ora dato che dobbiamo evidenziare delle celle creiamo un nuovo array con gli stessi
' limiti dell'array delle celle dei numeri questo nuovo array servira a memorizzare il colore
' di ciascuna cella
ReDim aColoriCelle(nQRigheGrliglia,57)
' imposto i colori di default che si differenziano tra colonna data, ritardo, numeriestratti
Call ImpostaColoriDefault(aColoriCelle,vbYellow,RGB(255,196,136),RGB(255,255,213),RGB(255,255,168))
' eseguo la ricerca voluta dall'utente
' fondamentalmente la ricerca consiste nel settare nell'array aColoriCelle il valore del colore
' della cella alle tali coordinate in funzione del tipo di ricerca.
' infatti le funzioni CercaSomme o CercaDistanze individueranno delle caselle
' adiacenti sia in orizzontale che in vericale con i numeri che rispettano
' il criterio di ricerca e allora queste celle
' prenderanno un colore diverso ,ricordiamo che stiamo ancora lavorando sull'array dei colori
' non sulla tabella di output
Select Case TipoRicerca ' chiedo all'utente la ricerca
Case 1 ' somma
nParamCercato = CInt(InputBox("Inserire la somma da cercare",,90))
Call CercaSomme(aCelle,aColoriCelle,nParamCercato,vbGreen ,bRicercaSuRuotaSing , bRicercaInVert)
Case 2 ' distanza
nParamCercato = CInt(InputBox("Inserire la distanza da cercare",,45))
Call CercaDistanze(aCelle,aColoriCelle,nParamCercato,vbGreen)
End Select
' a questo punto nell'array aCelle ho tutti i valori necessari per la tabella di output
' ho anche nell'array aColoriCelle i colori di ciascuna cella, alcuni saranno riamsti
' quelli di default , altri saranno stati alterati dalle funzioni di ricerca che hanno
' individuato le casellle adiacenti
' mostro quindi la tabella
Call PreparaTabella(aCelle,UBound(aCelle,2),aColoriCelle)
End Sub
Sub AlimentaArrayCellle(aCelle,nInizio,nFine)
' questa sub semplicemente alimenta l'array delle celle
' inserendo la data di estrazione, il ritardo e i numeri di
' ciascuna delle righe previste per la tabella
Dim k,r,e,i
Dim nIdEstr
nIdEstr = nInizio ' imposto l'estrazione iniziale
For k = 1 To UBound(aCelle) ' ciclo per le righe dell'array (cioe le righe finali della tabella)
aCelle(k,1) = GetInfoEstrazione(nIdEstr) ' la colonna 1 è la data
aCelle(k,2) = nFine - nIdEstr ' la colonna 2 è il ritardo rispetto all'estrazione finale
' ora faccio un ciclo per alimentare gli estratti delle 11 ruote
i = 2
For r = 1 To 12
If r <> 11 Then
For e = 1 To 5
i = i + 1
aCelle(k,i) = Estratto(nIdEstr,r,e)
Next
End If
Next
nIdEstr = nIdEstr + 1 ' incremento l'estrazione
Next
End Sub
Sub PreparaTabella(aCelle,nColonne,aColoreCelle)
' questa funzione costruisce la tabella di output usando i dati
' presenti in memoria nell'array aCelle , p in grado di impostare
' i colori per le celle perche li legge dall'array aColoreCelle
Dim k,kk,i
ReDim aV(nColonne)
' =========================================================================================
' riga dei titoli , necessita di gestire il ColSpan per unire le 5 caselle del nome ruota
' gestisce il ColSpan
ReDim aV(nColonne)
ReDim aColSpan(nColonne)
aColSpan(1) = 1 ' la prima colonna ha un colspan di 1 cioe copre se stessa
aColSpan(2) = 1 ' la seconda colonna ha un colspan di 1 cioe copre se stessa
' imposto i titoli per le colonne 1 e 2
aV(1) = "<b>Data</b>" ' imposto in grassetto (<b>...</b>)
aV(2) = "<b>Ritardo</b>"
' ora con un ciclo imposto i valori per il colspan delle colonne rimanenti
' e anche il loro valore , notare che per riferirci alla colonna della
' tabella usiamo la variabile i che parte da 2 perche le prime
' 2 colonne le abbiamo pocanzi gestite
i = 2
For k = 1 To 12 ' ciclo sulle ruote
If k <> 11 Then' se non è la ruota tutte
For kk = 1 To 5 ' ciclo sui 5 estratti
i = i + 1 ' incremento l'indice per riferirmi alla colonna della tabella
If kk = 1 Then
' se è la prima delle 5 colonne
aColSpan(i) = 5 ' il col span copre 5 colonne
aV(i) = "<b>" & NomeRuota(k) & "</b>" ' imposto il nome ruota in grassetto
Else
' se non è la prima delle 5 colonne
aColSpan(i) = 0 ' il colspan vale 0 perche gia gestito dalla prima colonna
aV(i) = "" ' anche il valore della cella nella colonna è impostato a stringa vuota
End If
Next
End If
Next
' a questo punto ho la riga dei titoli per la tabella , e ho anche l'array del ColSpan
' ricordiamo che il colspan gestisce l'unione delle 5 colonne con il nome ruota, ogni ruota infatti
' copre 5 colonne che noi gestiamo col ColSpan per fare in modo di unire le celle
Call InitTabella(aV,vbBlue,,,vbWhite,"Courier New",aColSpan)
' ==========================================================================================
' ora che abbiamo inserito la riga per i titoli dobbiamo gestire il contenuto della table
' alimentando tutte le righe con Data, Ritardo ,Estratti
' ricordiamo che questi valor li abbiamo nell'array aCelle
' dobbiamo anche contestualmente colorare le celle , anche in questo caso possiamo
' leggere il colore delle celle dall'array aColoreCelle
ReDim aColori(nColonne) ' preparo l'array per impostare i colori delle celle della singola riga
' di volta in volta leggero i valori dei colori della riga corrente
' prendendoli dall'array aColoreCelle
' ciclo sulle righe dell'array per alimentare tutte le righe della tabella
For k = 1 To UBound(aCelle)
ReDim aV(nColonne) ' dimesiono l'array per impostare i valori della riga per ogni colonna
For kk = 1 To nColonne ' ciclo sulle colonne leggo il valore e il colore delle celle
aV(kk) = aCelle(k,kk) ' leggo il valore
aColori(kk) = aColoreCelle(k,kk) ' leggo il colore
Next
' a questo punto ho sia i valori che i colori per la nuova riga
' quindi la aggiungo alla tabella
Call AddRigaTabella(aV,aColori,,,,"Courier New")
Call AvanzamentoElab(1,UBound(aCelle),k)
Next
' dato che la tabella contiene molti dati per evitare problemi
' di visualizzazione imposto la larghezza in pixel per la tabella
Call SetTableWidth("1900px")
' creo la tabella
Call CreaTabella
End Sub
Sub ImpostaColoriDefault(aColoriCelle,nColoreData,nColoreRit,nColore1,nColore2)
' questa funzione agisce sull'array che memorizza i colori di ciascuna cella
' e ne imposta i colori di default
Dim k,kk
Dim nColonne
Dim i,nColore
nColonne = UBound(aColoriCelle,2) ' ottengo di quante coloenne è fatto l'array
For k = 1 To UBound(aColoriCelle) ' ciclo sulle righe
nColore = nColore1
i = 0
For kk = 1 To nColonne ' ciclo interno sulle colonne
If kk = 1 Then
' se la colonna è la 1 è la data e imposto il colore appropriato
aColoriCelle(k,kk) = nColoreData
ElseIf kk = 2 Then
' se la colonna è la 2 è il ritardo e imposto il colore appropriato
aColoriCelle(k,kk) = nColoreRit
Else
aColoriCelle(k,kk) = nColore
'negli altri casi il colore appropriato è quello per l'area dei numeri estratti
If(kk - 2) Mod 5 = 0 Then
If nColore = nColore1 Then
nColore = nColore2
Else
nColore = nColore1
End If
End If
End If
Next
Next
End Sub
Sub CercaSomme(aCelle,aColoriCelle,nSommaVoluta,nColore,bRuotaSingola,bRicercaVerticale)
' questa funzione opera sull'array delle celle alla ricerca di celle adiacenti
' i cui numeri sommati diano il valore cercato
' quando trova le celle adiacenti che rispettano la condizione
' va ad impostare il colore delle celle nell'apposito array aColoriCelle
Dim k,kk
Dim nColonne
Dim nA,nB,R
nColonne = UBound(aCelle,2)
For k = 1 To UBound(aCelle)
If bRuotaSingola = False Then
For kk = 3 To nColonne - 1
If Fuori90(aCelle(k,kk) + aCelle(k,kk + 1)) = nSommaVoluta Then
aColoriCelle(k,kk) = nColore
aColoriCelle(k,kk + 1) = nColore
End If
Next
Else
nA = 3
For R = 1 To 11
nB =(nA - 1) + 5
For kk = nA To nB - 1
If Fuori90(aCelle(k,kk) + aCelle(k,kk + 1)) = nSommaVoluta Then
aColoriCelle(k,kk) = nColore
aColoriCelle(k,kk + 1) = nColore
End If
Next
nA = nB + 1
Next
End If
Call AvanzamentoElab(1,UBound(aCelle),k)
Next
If bRicercaVerticale Then
For k = 1 To UBound(aCelle) - 1
For kk = 3 To nColonne
If Fuori90(aCelle(k,kk) + aCelle(k + 1,kk)) = nSommaVoluta Then
aColoriCelle(k,kk) = nColore
aColoriCelle(k + 1,kk) = nColore
End If
Next
Call AvanzamentoElab(1,UBound(aCelle) - 1,k)
Next
End If
End Sub
Sub CercaDistanze(aCelle,aColoriCelle,nDistanzaVoluta,nColore,bRuotaSingola,bRicercaVerticale)
' questa funzione opera sull'array delle celle alla ricerca di celle adiacenti
' i cui numeri abbiano distanza del valore cercato
' quando trova le celle adiacenti che rispettano la condizione
' va ad impostare il colore delle celle nell'apposito array aColoriCelle
Dim k,kk
Dim nColonne
Dim nA,nB,R
nColonne = UBound(aCelle,2)
For k = 1 To UBound(aCelle)
If bRuotaSingola = False Then
For kk = 3 To nColonne - 1
If Distanza(aCelle(k,kk),aCelle(k,kk + 1)) = nDistanzaVoluta Then
aColoriCelle(k,kk) = nColore
aColoriCelle(k,kk + 1) = nColore
End If
Next
Else
nA = 3
For R = 1 To 11
nB =(nA - 1) + 5
For kk = nA To nB - 1
If Distanza(aCelle(k,kk),aCelle(k,kk + 1)) = nDistanzaVoluta Then
aColoriCelle(k,kk) = nColore
aColoriCelle(k,kk + 1) = nColore
End If
Next
nA = nB + 1
Next
End If
Call AvanzamentoElab(1,UBound(aCelle),k)
Next
If bRicercaVerticale Then
For k = 1 To UBound(aCelle) - 1
For kk = 3 To nColonne
If Distanza(aCelle(k,kk),aCelle(k + 1,kk)) = nDistanzaVoluta Then
aColoriCelle(k,kk) = nColore
aColoriCelle(k + 1,kk) = nColore
End If
Next
Call AvanzamentoElab(1,UBound(aCelle) - 1,k)
Next
End If
End Sub
Function TipoRicerca
' chiede all'utente il tipo di ricerca
ReDim aVoci(2)
aVoci(1) = "Somme"
aVoci(2) = "Distanza"
TipoRicerca = ScegliOpzioneMenu(aVoci,1,"Tipo ricerca")
End Function
Ultima modifica di un moderatore:
Lanfranco60
Super Member >GOLD<
Alla faccia del bicarbonato di sodio, corbezzoli e pinzillacchere !
Io sono riuscito a malapena a creare una schifezza di tabella come la volevo, ma poi mi sono reso conto,
tramite Joe91, che c'era il problema dei numeri a cavallo tra due ruote, ma poi non solo quello.
Ho provato a fare tutta un altro tipo di tabella e ci stavo riuscendo, ma lo script si stava allungando all'infinire e poi mi sono inceppato.
..e quando ci sarei riuscito.....seeeeeee....
Pubblico ringraziamento va a tutti quelli che mi hanno aiutato,( Blackmore,mike58,Joe91,Rosanna) e infine il maestro LuigiB che come al solito se ne uscito con uno dei suoi script da urlo. GRAZIE !!!
PS: Luigi, le somme verticali non le digerisco proprio, se le volevo guardavo il tabellone in spaziometria (solo orizzontale !)
Io sono riuscito a malapena a creare una schifezza di tabella come la volevo, ma poi mi sono reso conto,
tramite Joe91, che c'era il problema dei numeri a cavallo tra due ruote, ma poi non solo quello.
Ho provato a fare tutta un altro tipo di tabella e ci stavo riuscendo, ma lo script si stava allungando all'infinire e poi mi sono inceppato.
..e quando ci sarei riuscito.....seeeeeee....
Pubblico ringraziamento va a tutti quelli che mi hanno aiutato,( Blackmore,mike58,Joe91,Rosanna) e infine il maestro LuigiB che come al solito se ne uscito con uno dei suoi script da urlo. GRAZIE !!!
PS: Luigi, le somme verticali non le digerisco proprio, se le volevo guardavo il tabellone in spaziometria (solo orizzontale !)
L
LuigiB
Guest
Ciao , ho messo le funzioni piu che altro per far vedere come si fa , ora se hai capito il concetto inserire altre ricerche oevitare le ricerche a cavallo sarà facile...
Ultima modifica di un moderatore:
Lanfranco60
Super Member >GOLD<
He He, Fare uno script tutto sommato è "facile", ..e quando diventa una sfida intellettuale con se stessi che incomincia il divertimento !
R
Roby
Guest
Ed io che pensavo di avere fatto una bellissima tabella (Classica)... 
Vabè il Maestro è sempre il maestro
Vabè il Maestro è sempre il maestro
L
LuigiB
Guest
ahah vabbe dai ho dovuto anche fare delle modifiche sul programma per consentire cio.. si poteva fare pure prima ma solo con 6 ruote almeno sul mio pc .. dipendeva dalla dimensione della tabella che per 11 ruote era troppo corta e dava problemi seicche ho aggiunto una nuova funzione che consente di impostare esliictamente il valore per la larghezza della tabella
Ciao
Ciao
Lanfranco60
Super Member >GOLD<
Ciao Luigi, grazie per questo script, con tutti i commenti che hai messo,
tante cose sono un pò più chiare adesso.
E da quello che vedo è stato utile a molti.
Io mi lamentavo del fatto che non volevo le combinazioni cercate anche
in verticale, ma SOLO in orizzontale.
Perchè così comè, assomiglia tale e quale alla funzione che c'è in spaziometria
che oltretutto è più veloce.
Con i tuoi preziosissimi commenti, sono riuscito a modificare lo script e togliere la
ricerca in verticale.
Ma sono riuscito a fare di più, ho aggiunto un secondo parametro somma da cercare
congiunto alla prima somma e gli ho dato un colore diverso, il tutto
creando un altra Sub cercaSomme.
(sembra chissa che, ma i progressi si fanno a piccoli passi)
L'unica cosa che non va, ( ne abbiamo discusso in post precedenti io e Joe91)
sarebbe che non si riesce a fare in modo che NON CAPITI che il parametro cercato,
vada a trovarsi a cavallo fra due ruote.
(un numero in una ruota e l'altro numero nella ruota successiva/
tipo 5°estratto di una ruota e 1°estratto della successiva).
hai detto che sarebbe facile evitare quelle a cavallo, ma come ? un Indizio ?
ciao
ecco lo script modificato
Nota : Ho tolto tutti i commenti e remmato solo le linee dove sono intervenuto con le modifiche
Codice:
Option Explicit
Sub Main
Dim nQRigheGriglia
Dim nInizio,nFine
Dim nParamCercato1'Ho aggiunto 1 a nParamCercato
Dim nParamCercato2'Ho aggiunto questa Dim
nQRigheGriglia = 50
nFine = EstrazioneFin
nInizio =(nFine - nQRigheGriglia) + 1
ReDim aCelle(nQRigheGriglia,57)
Call AlimentaArrayCelle(aCelle,nInizio,nFine)
ReDim aColoriCelle(nQRigheGriglia,57)
Call ImpostaColoriDefault(aColoriCelle,vbYellow,RGB(255,196,136),vbWhite)
Select Case TipoRicerca
Case 1
nParamCercato1 = CInt(InputBox("Inserire la prima somma da cercare",,90))
nParamCercato2 = CInt(InputBox("Inserire la seconda somma da cercare",,45))'Ho aggiunto questa inputBox
Call CercaSomme1(aCelle,aColoriCelle,nParamCercato1,vbGreen)'Ho aggiunto 1 alla Sub CercaSomme modificata
Call CercaSomme2(aCelle,aColoriCelle,nParamCercato2,vbYellow)'Ho aggiunto la Call alla nuova Sub creata CercaSomme2 + il nParamCercato2
'e modificato il colore con cui evidenzia la seconda somma
Case 2
nParamCercato1 = CInt(InputBox("Inserire la distanza da cercare",,45))
Call CercaDistanze(aCelle,aColoriCelle,nParamCercato1,vbGreen)
End Select
Call PreparaTabella(aCelle,UBound(aCelle,2),aColoriCelle)
End Sub
Sub AlimentaArrayCelle(aCelle,nInizio,nFine)
Dim k,r,e,i
Dim nIdEstr
nIdEstr = nInizio
For k = 1 To UBound(aCelle)
aCelle(k,1) = GetInfoEstrazione(nIdEstr)
aCelle(k,2) = nFine - nIdEstr
i = 2
For r = 1 To 12
If r <> 11 Then
For e = 1 To 5
i = i + 1
aCelle(k,i) = Estratto(nIdEstr,r,e)
Next
End If
Next
nIdEstr = nIdEstr + 1
Next
End Sub
Sub PreparaTabella(aCelle,nColonne,aColoreCelle)
Dim k,kk,i
ReDim aV(nColonne)
ReDim aV(nColonne)
ReDim aColSpan(nColonne)
aColSpan(1) = 1
aColSpan(2) = 1
aV(1) = "<b>Data</b>"
aV(2) = "<b>Ritardo</b>"
i = 2
For k = 1 To 12
If k <> 11 Then
For kk = 1 To 5
i = i + 1
If kk = 1 Then
aColSpan(i) = 5
aV(i) = "<b>" & NomeRuota(k) & "</b>"
Else
aColSpan(i) = 0
aV(i) = ""
End If
Next
End If
Next
Call InitTabella(aV,vbBlue,,,vbWhite,"Courier New",aColSpan)
ReDim aColori(nColonne)
For k = 1 To UBound(aCelle)
ReDim aV(nColonne)
For kk = 1 To nColonne
aV(kk) = aCelle(k,kk)
aColori(kk) = aColoreCelle(k,kk)
Next
Call AddRigaTabella(aV,aColori,,,,"Courier New")
Call AvanzamentoElab(1,UBound(aCelle),k)
Next
Call SetTableWidth("1900px")
Call CreaTabella
End Sub
Sub ImpostaColoriDefault(aColoriCelle,nColoreData,nColoreRit,nColore)
Dim k,kk
Dim nColonne
nColonne = UBound(aColoriCelle,2)
For k = 1 To UBound(aColoriCelle)
For kk = 1 To nColonne
If kk = 1 Then
aColoriCelle(k,kk) = nColoreData
ElseIf kk = 2 Then
aColoriCelle(k,kk) = nColoreRit
Else
aColoriCelle(k,kk) = nColore
End If
Next
Next
End Sub
Sub CercaSomme1(aCelle,aColoriCelle,nSommaVoluta1,nColore)'Ho modificato la Sub in CercaSomme1 e relativi parametri
Dim k,kk
Dim nColonne
nColonne = UBound(aCelle,2)
For k = 1 To UBound(aCelle)
For kk = 3 To nColonne - 1
If Fuori90(aCelle(k,kk) + aCelle(k,kk + 1)) = nSommaVoluta1 Then
aColoriCelle(k,kk) = nColore
aColoriCelle(k,kk + 1) = nColore
End If
Next
Call AvanzamentoElab(1,UBound(aCelle),k)
Next
End Sub
Sub CercaSomme2(aCelle,aColoriCelle,nSommaVoluta2,nColore)'Ho aggiunto questa Sub con nSommaVoluta2
Dim k,kk
Dim nColonne
nColonne = UBound(aCelle,2)
For k = 1 To UBound(aCelle)
For kk = 3 To nColonne - 1
If Fuori90(aCelle(k,kk) + aCelle(k,kk + 1)) = nSommaVoluta2 Then
aColoriCelle(k,kk) = nColore
aColoriCelle(k,kk + 1) = nColore
End If
Next
Call AvanzamentoElab(1,UBound(aCelle),k)
Next
End Sub
Sub CercaDistanze(aCelle,aColoriCelle,nDistanzaVoluta,nColore)
Dim k,kk
Dim nColonne
nColonne = UBound(aCelle,2)
For k = 1 To UBound(aCelle)
For kk = 3 To nColonne - 1
If Distanza(aCelle(k,kk),aCelle(k,kk + 1)) = nDistanzaVoluta Then
aColoriCelle(k,kk) = nColore
aColoriCelle(k,kk + 1) = nColore
End If
Next
Call AvanzamentoElab(1,UBound(aCelle),k)
Next
End Sub
Function TipoRicerca
ReDim aVoci(2)
aVoci(1) = "Somme"
aVoci(2) = "Distanza"
TipoRicerca = ScegliOpzioneMenu(aVoci,1,"Tipo ricerca")
End Function
Ultima modifica:
Ultima estrazione Lotto
-
Estrazione del lotto
sabato 18 gennaio 2025Bari2476027212Cagliari2108770417Firenze7484071272Genova1307334718Milano0134095548Napoli4623250306Palermo4407014684Roma8878647404Torino0787673853Venezia3125041802Nazionale4982596567Estrazione Simbolotto
Bari
0313312335
