Condividi:        

Test punti

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Test punti

Postdi crisros » 10/09/10 21:13

Avrei bisogno ancora del vostro aiuto, non riesco a creare una macro per cercare nel foglio Archivio i punti ralizzati
dalle colonne inserite nel foglio test.
Inserisco file esempio.
http://rapidshare.com/files/418302726/F ... pione.xlsx

Lo so che non sono stato chiaro nell'esposizione del problema spero che il file allegato sia più chiaro.

Grazie per la vostra attenzione. :)
crisros
Utente Junior
 
Post: 14
Iscritto il: 17/05/10 11:21

Sponsor
 

Re: Test punti

Postdi Flash30005 » 10/09/10 22:17

Faccio di più! ;)
ti invio un file con il quale potrai confrontare più sistemi e loro costi a breve e lungo termine
Il file ha un'impostazione diversa rispetto al tuo ma raggiunge lo stesso scopo.
Potrai eliminare i fogli che non ti interessano e lasciarne solo uno, con l'archivio e le colonne da confrontare, in questa maniera dovrebbe soddisfare la tua esigenza.
Scarica questo file provalo e fai sapere

Ciao


P.s. Nuovo link download file (stesso file del post delle ore 3:16) per permettere ulteriori download (modifica post ore 12:30 dell'11/09/2010)
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Test punti

Postdi ricky53 » 10/09/10 23:07

Ciao Flash,
puoi inserire il link corretto al tuo file.

Grazie.

Ciao da Ricky53
Dice il vecchio saggio provare e riprovare è l'unica strada per imparare

Più chiara è la vostra spiegazione
Più immediata sarà la nostra soluzione


. . . . . . . . . .
S.O. W10; Office 2003-10-13-16-19
Avatar utente
ricky53
Utente Senior
 
Post: 4565
Iscritto il: 11/04/09 19:29
Località: Italia

Re: Test punti

Postdi Flash30005 » 10/09/10 23:33

Si scusate,
ma mi sono reso conto che il file era abbastanza complesso per questa esigenza
magari, Crisros preferirebbe qualcosa di più adatto al suo schema
cosicché ho modificato la macro adattandola alle sue esigenze
e la pubblico ora
Codice: Seleziona tutto
Sub ControllaSistema()
'Application.ScreenUpdating = False
'Application.Calculation = xlManual
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
URS = Worksheets("Archivio").Range("F" & Rows.Count).End(xlUp).Row
URIS = Worksheets("Test").Range("Q" & Rows.Count).End(xlUp).Row
    Worksheets("Test").Range("W4:AD18").ClearContents
    For R1 = 2 To URS
        Application.StatusBar = "Controllo Concorso " & R1 & " Su " & URS & " " & Int((R1 / URS) * 100) & " %"
        For R2 = 4 To URIS
            NU = 0
            For C1 = 6 To 11
                For C2 = 17 To 22
                    If Worksheets("Archivio").Cells(R1, C1).Value = Worksheets("Test").Cells(R2, C2).Value Then
                        NU = NU + 1
                    End If
                Next C2
        Next C1

        If NU > 2 Then
               Worksheets("Test").Cells(R2, 20 + NU).Value = Worksheets("Test").Cells(R2, 20 + NU).Value + 1
            If NU = 5 Then
                For C5 = 17 To 22
                    If Worksheets("Archivio").Cells(R1, 12).Value = Worksheets("Test").Cells(R2, C5).Value Then
                        Worksheets("Test").Cells(R2, 27).Value = Worksheets("Test").Cells(R2, 27).Value + 1
                    End If
                Next C5
            End If
        End If
        Next R2
    Next R1
Application.DisplayStatusBar = oldStatusBar
Application.DisplayStatusBar = False
'Application.Calculation = xlCalculationAutomatic
'Application.ScreenUpdating = True
End Sub


Con il suo file funziona perfettamente
L'unica cosa che ho tralasciato è la data di "Ultima estrazione vincente" se occorre la si aggiunge
inserendo la riga nel punto indicato da questo codice
Codice: Seleziona tutto
If NU > 2 Then            '<<<< esistente
Worksheets("Test").Cells(R2, 20 + NU).Value = Worksheets("Test").Cells(R2, 20 + NU).Value + 1  '<<<< esistente
Worksheets("Test").Cells(R2, 30).Value = Worksheets("Archivio").Cells(R1, 5)   '<<<< aggiungere qui
If NU = 5 Then           '<<<< esistente


Perché penso che si dovrebbe inserire la data della vincita maggiore che prevede una modifica diversa della macro

Fate sapere
Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Test punti

Postdi Flash30005 » 11/09/10 02:16

Qui pubblico il file per testare i sistemi a breve e a lungo termine.
L'archivio è dal 1939 al 2009 nessuno vieta di copiare l'archivio su un altro foglio e fare un'analisi più a breve termine oppure implementare la macro con la condizione di terminare la routine all'anno X ma lo scopo è proprio quello di dimostrare che qualsiasi sistema utilizziate alla fine i costi superano di gran lunga le vincite.
Il sistema in esame (dalla colonna J alla colonna O) è un sistema che garantisce il "due sicuro" di 164 colonne e vi posso garantire che effettivamente qualsiasi colonna esca si hanno come minimo 2 punti ma questo non giova molto.

Con questo programma potete testare i vostri sistemi prima di perdere bei soldini.
Qualcuno dirà "Ma sìììì! Io faccio altri tipi di analisi che mi permettono di vincere di più!" oppure "Ho trovato il sistema sicuro!"
E' ricorrente, nell'indole umana, pensare di essere più intelligenti o più furbi del prossimo e quindi...
qualcuno ci rivolgerà problematiche da risolvere con formule e/o macro allo scopo di ottenere lo strumento per avere conferma di aver ragione ma questo, non potendo accadere, porta a due situazioni,
la prima che il richiedente si rende conto che le cose non stanno proprio come pensava e rimuove l'idea iniziale (a volte senza pochi "effetti collaterali"),
la seconda (richiedente "ostinato") non dà colpa a se stesso ma al programma che non elabora come dovrebbe ciò che intendeva (in effetti intendeva che l'intera elaborazione fornisse i numeri vincenti) :eeh:

Anni fa mi un signore mi chiese di realizzare un programma con certe sue specifiche.
Solo per capire le specifiche ho impiegato diverso tempo e molto ma molto di più per realizzare quanto desiderava ma non riuscivo a capire perché "ruotassero ciclicamente" certe condizioni e alla mia domanda di chiarimento mi disse "per rendere l'elaborazione condizionata ancora più casuale" :eeh: :eeh: :eeh:


Detto questo farei una domanda, anzi una considerazione (visto che trattasi di domanda con risposta):
come mai, in vendita, ci sono tanti programmi di analisi, di "previsioni", di elaborazione dati a non finire che garantiscono vincite "sicure"?
Forse perché queste persone/società hanno più entrate vendendo i programmi che giocare loro stessi le previsioni fornite dal frutto del loro "ingegno" (?)

Comunque con il file pubblicato in questo post ognuno avrà modo di constatare di persona se certe convinzioni meritano o no di essere prese in considerazione,
se sì, potete sempre pubblicare il sistema che ha dato a breve o a lungo termine una vincita superiore alla spesa e saremo tutti lieti di "migliorare" il sistema.

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Test punti

Postdi crisros » 12/09/10 16:00

Ciao Flash30005 In ritardo Ti RINGRAZIO tantissimo la tua macro è eccezionale, ero sicurissimo che la tua bravura avrebbe risolto il mio problema :lol:
Per quanto riguarda il file postato da te, ottimo anche se un po lento, mi devi solo delucidare come aggiornare l'archivio perchè se sostituisco quello inserito da te quando lancio la macro la stessa va in errore.
"Cells(RAnno, 36).Value = Cells(RAnno, 36).Value + 1" si blocca su questa riga.
Per il sistema se merita ti renderò partecipe.
Un Saluto a Te e a tutti gli amici del forum.
crisros
Utente Junior
 
Post: 14
Iscritto il: 17/05/10 11:21

Re: Test punti

Postdi Flash30005 » 12/09/10 16:29

Molto probabilmente prendi dal web un archivio non compatibile
Ti passo questo link
non devi far altro che copiare l'anno in corso (controlla bene perché sembra che manchino alcune estrazione di inizio anno) e incollare su un foglio appoggio
noterai che rispetto al mio archivio c'è la colonna B in più che è vuota
cancelli la colonna B
ora è compatibile
non devi fare altro che un copia incolla dell'archivio del mio file e incollarlo alla fine di questo nuovo archivio per continuare ad avere tutte le estrazioni dal 1939 ad oggi in ordine decrescente di data.
A questo punto puoi prendere solo un periodo di estrazioni e riportarle nel foglio3 del programma
fai attenzione a togliere le estrazioni precedenti.

Il tutto si può automatizzare anche attraverso una registrazione macro e adattare il codice prodotto

ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Test punti

Postdi Flash30005 » 12/09/10 17:24

Vedo che tentenni... :roll:

Ok apri una nuova cartella di excel e rinomina un foglio con nome "Internet"
e un altro con nome "Appoggio"
inserisci in un modulo questo codice
Codice: Seleziona tutto
Sub CreaArchivioStoricoDaWeb()
For QW = 2009 To Year(Now())
Segno = "superenalotto-" & QW & ".html"
If QW = Year(Now()) Then
Call SEnalottoAnnoA
GoTo Salta
End If
     Sheets("Internet").Select
    Range("A1").Select
    Cells.Select
    Selection.Clear
    'Selection.QueryTable.Delete
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.estrazionidellotto.com/" & Segno, Destination:=Range("A1"))
        .Name = "superenalotto-" & QW
        .Name = Replace(Segno, ".html", "")
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "4"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

    Application.CommandBars("External Data").Visible = False
    Sheets("Internet").Select
    Rows("1:2").Select
    Selection.Delete Shift:=xlUp
    Rows("105").Select
    Selection.Delete Shift:=xlUp
    Sheets("Internet").Select
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft

Righe = Range("A" & Rows.Count).End(xlUp).Row
    Columns("A:I").Select
    Columns("A:I").EntireColumn.AutoFit
    Range("K3").Select
    Sheets("Appoggio").Select
    Rows("1:1").Select
    For IR = 1 To Righe
    Selection.Insert Shift:=xlDown
    Next IR
    Range("A1").Select
    Sheets("Internet").Select
    Range("A1:I" & Righe).Select
    Selection.Copy
    Sheets("Appoggio").Select
    ActiveSheet.Paste
    Columns("A:I").Select
    Columns("A:I").EntireColumn.AutoFit
    Range("K3").Select

    Next QW
Salta:
End Sub
Sub SEnalottoAnnoA()
Application.ScreenUpdating = False
     Sheets("Internet").Select
    Range("A1").Select
    Cells.Select
    Selection.Clear
    With ActiveSheet.QueryTables.Add(Connection:="URL;http://www.estrazionidellotto.com/estrazioni_superenalotto.htm", _
        Destination:=Range("A1"))
        .Name = "estrazioni_superenalotto_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "11"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Application.CommandBars("External Data").Visible = False
    Sheets("Internet").Select
    Rows("1:2").Select
    Selection.Delete Shift:=xlUp
    Rows("105").Select
    Selection.Delete Shift:=xlUp
    Sheets("Internet").Select
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft

Righe = Range("A" & Rows.Count).End(xlUp).Row
    Columns("A:I").Select
    Columns("A:I").EntireColumn.AutoFit
    Range("K3").Select
    Sheets("Appoggio").Select
    Rows("1:1").Select
    For IR = 1 To Righe
    Selection.Insert Shift:=xlDown
    Next IR
    Range("A1").Select
    Sheets("Internet").Select
    Range("A1:I" & Righe).Select
    Selection.Copy
    Sheets("Appoggio").Select
    ActiveSheet.Paste
    Columns("A:I").Select
    Columns("A:I").EntireColumn.AutoFit
    Range("K3").Select
Application.ScreenUpdating = True

    End Sub

Avvia la macro "Sub CreaArchivioStoricoDaWeb"
settando l'anno inizio generazione archivio (dove ora c'è 2009)
e aspetta che finisca
poi puoi copiare queste righe e inserirle nel foglio3 del programma test sistema (cancella prima quelle esistenti)
Chiaramente più estrazioni e più colonne sistema hai e più tempo occorre
mediamente una ventina di minuti con 164 colonne sistema per tutte le estrazioni dal 1939

se il sistema è di sole 15 colonne come lo è il tuo i tempi sono più brevi come pure saranno più brevi se inizi l'elaborazione da quando è stato istituito il superenalotto, dal 2002 in poi
oppure dal 1° luglio 2009, data in cui si è svincolato dal lotto e le estrazioni sono effettuate esclusivamente per questo gioco.

ciao

P.s. Non capisco come mai manchino alcune estrazioni relative a gennaio di questo anno, la tabella infatti riporta dal 14 gennaio in poi :roll:
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Test punti

Postdi crisros » 12/09/10 17:44

Grazie Flash,funziona benissimo la tua macro, effettivamente mancano le prime estrazioni del 2010.
P.S. non tentennavo ero momentaneamente assente :lol:
Comenque GRAZIE
crisros
Utente Junior
 
Post: 14
Iscritto il: 17/05/10 11:21


Torna a Applicazioni Office Windows


Topic correlati a "Test punti":

2 PUNTI
Autore: giorgioa
Forum: Applicazioni Office Windows
Risposte: 15

Chi c’è in linea

Visitano il forum: Nessuno e 29 ospiti