Condividi:        

Excel, Lotto, Senza Macro !! ???

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

Re: Excel, Lotto, Senza Macro !! ???

Postdi rosseaux » 11/08/11 10:31

Ok Flash....dalla mia ricerca è emerso che quasi tutti i siti che ho trovato, ti fanno scaricare un file zip....meno che questo:

http://www.lottoanalyzer.it/estra.asp?data=10102100&gioco=0&concorso=8414

se si modifica quell'"8414" finale nell'indiirizzo ad esempio in "8413" si ha l'estrazione della volta prima....e così via...

non sò quanto possa essere buono....

secondo me la migliore via....anche se più complessa....è quella di trovare un modo di scompattare lo zip dall'archivio storico originale...

ma non ho capito se è possibile..

...ah poi ti ricordi il programmino che avevi fatto TU del Lotto ??

Lotto90Ana_V14.xls ???

lì c'è un pulsante dove aggiorna da un "X" Archivio..e funziona alla grande..ho visto ora....solo che è protetto da password l'accesso al VBA...e mi sembra Giusto....

Ognuno deve avere i propri Segreti....ihihiih... ;)
rosseaux
Utente Senior
 
Post: 151
Iscritto il: 06/01/07 14:11
Località: Alfonsine (RA)

Sponsor
 

Re: Excel, Lotto, Senza Macro !! ???

Postdi Flash30005 » 11/08/11 13:52

Non c'è alcun segreto perché, se così fosse, non lo inserirei mai in un file di excel, anche se protetto :lol:
Quel programma è stato ideato da un utente e realizzato da me
La protezione è stata inserita solo a "difesa" dell'idea.
Ho preparato questa macro che farà aggiornare il tuo archivio (assegnerai un pulsante comando per l'avvio)
Codice: Seleziona tutto
Sub CreaArchDaWeb()
Application.ScreenUpdating = False
Application.Calculation = xlManual
AnnoA = 1939
Set Ws1 = Worksheets("Archivio1939")
Set Ws3 = Worksheets("Appoggio")
Set Ws4 = Worksheets("Appoggio2")
URS = Ws1.Range("A" & Rows.Count).End(xlUp).Row
If Ws1.Range("A" & URS).Value <> "" Then AnnoA = Year(Ws1.Range("A" & URS).Value)
For annoweb = AnnoA To Year(Now)
    Ws3.Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.lottoconsult.it/estrazioni_lotto.asp?anno=" & annoweb, Destination:=Range("A1"))
        .Name = "estrazioni_lotto.asp?anno=" & annoweb
        .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 = "7,8"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Rows("1:2").Select
    Selection.Delete Shift:=xlUp
   
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    UR1 = Ws3.Range("A" & Rows.Count).End(xlUp).Row
    UR2 = Ws4.Range("A" & Rows.Count).End(xlUp).Row
    For Cdata = 1 To UR1
        Range("A" & Cdata).Value = Format(Mid(Range("A" & Cdata).Value, 6, 15), "MM/DD/yyyy")
    Next Cdata
    If annoweb < 2005 Then
        Columns("B:B").Select
        For AggC = 1 To 5
            Selection.Insert Shift:=xlToRight
        Next AggC
    End If
    Columns("B:BD").Select
    Selection.ColumnWidth = 2.54
    Ws3.Range("A1:BD" & UR1).Select
    Selection.Copy
    Sheets("Appoggio2").Select
    X = 1
    If UR2 = 1 Then X = 0
    Range("A" & UR2 + X).Select
    ActiveSheet.Paste
    Ws3.Select
    Range("A1:BD" & UR1).Clear
    Range("A1").Select
Next annoweb
Ws4.Select
Call Incolonna
   ' Sheets("Sistema").Select
    Range("A1").Select
    Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Incolonna()
Dim Vettore(11) As String
Vettore(1) = "RN"
Vettore(2) = "BA"
Vettore(3) = "CA"
Vettore(4) = "FI"
Vettore(5) = "GE"
Vettore(6) = "MI"
Vettore(7) = "NA"
Vettore(8) = "PA"
Vettore(9) = "RM"
Vettore(10) = "TO"
Vettore(11) = "VE"
UR2 = Ws4.Range("A" & Rows.Count).End(xlUp).Row
URC = Ws4.Range("IV1").End(xlToLeft).Column
URS = Ws1.Range("A" & Rows.Count).End(xlUp).Row
 'cancella estrazioni doppie
For CD = URS - 1 To 2 'Step 11
UR2 = Ws4.Range("A" & Rows.Count).End(xlUp).Row
    Data1 = Ws1.Range("A" & CD).Value
    For CD2 = UR2 To 1 Step -1
        If Ws4.Range("A" & CD2).Value = Data1 Then
            Ws4.Rows(CD2 & ":" & CD2).Delete Shift:=xlUp
            GoTo salta
        End If
    Next CD2
salta:
Next CD
    For IncR = 1 To UR2
        For IncC = 2 To URC Step 5
        ColS = 2
            DaTaE = Ws4.Cells(IncR, 1).Value
            If DaTaE = "" Then
                GoTo Esci
            End If
            Ruota = Int((IncC - 2) / 5) + 1
            RU = Vettore(Ruota)
            Ws1.Cells(URS + 1 + (IncR - 1) * 11 + Ruota, 1).Value = DaTaE
            Ws1.Cells(URS + 1 + (IncR - 1) * 11 + Ruota, 2).Value = RU
            For Cr = 1 To 5
                Ws1.Cells(URS + 1 + (IncR - 1) * 11 + Ruota, ColS + Cr).Value = Ws4.Cells(IncR, IncC + Cr - 1).Value
            Next Cr
        Next IncC
    Next IncR
URS = Ws1.Range("A" & Rows.Count).End(xlUp).Row
Ws1.Select
Range("A4:G" & URS).Select
Application.CutCopyMode = False
    Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Key2:=Range("B1") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
 'cancella estrazioni mancanti
 For S = URS To 1 Step -1
    If Range("C" & S) = "" Then Rows(S & ":" & S).Delete Shift:=xlUp
Next S

Esci:
End Sub

Premetto che il primo aggiornamento sarà molto lungo (circa un'ora) anche perché correggerà diverse estrazioni che il tuo archivio non aveva
Devi solo aggiungere due nuovi fogli (che potrai nascondere)
i fogli dovranno avere i seguenti nomi
"Appoggio" e "Appoggio2".

Avendo già effettuatao l'aggiornamento ti invio anche il file
Noterai che, con un archivio così aggiornato il processo sarà brevissimo ad ogni nuova estrazione.

Download File

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: Excel, Lotto, Senza Macro !! ???

Postdi rosseaux » 11/08/11 16:34

Flash Sei un GRANDEEEE !!!

Grazieeeee !!!

Ora però c'è un problema...

nel mio storico si creano più ruote di tutte le ruote..solo nell'anno 2011...cioè....ad esempio..

MI
MI
MI
MI
NA
NA
NA
NA

Si può risolvere ???...Sei Riuscito quasi a fargli fare anche il caffè a questo foglio.... :lol: :lol:

poi vorrei un attimo capire una cosa...

il foglio "Appoggio" che non si compila proprio....cosa appoggia ???

ah e come ultima cosa...non è che potresti commentare ogni riga quando l'avremo fatta corretta del tutto la Macro ???

così capisco bene tutto quello che fa... :D ;)

Ti sono veramente Grato per la Pazienza che hai con Me... ;)
rosseaux
Utente Senior
 
Post: 151
Iscritto il: 06/01/07 14:11
Località: Alfonsine (RA)

Re: Excel, Lotto, Senza Macro !! ???

Postdi Flash30005 » 11/08/11 21:54

La ripetizione è dovuta a un bug (modifica dell'ultimo minuto)
L'errore era solo su una riga della macro "Incolonna"
ma sostituisci le due macro perché ho reso più leggibile l'assegnazione delle variabile
Codice: Seleziona tutto
Sub CreaArchDaWeb()
Application.ScreenUpdating = False
Application.Calculation = xlManual
AnnoA = 1939 '<<<<assegno il primo anno ufficiale lotto
Set Ws1 = Worksheets("Archivio1939")  '<<< setto i vari fogli evitando di ripetere worksheet("nomefoglio")
Set Ws3 = Worksheets("Appoggio")
Set Ws4 = Worksheets("Appoggio2")
URS = Ws1.Range("A" & Rows.Count).End(xlUp).Row '<<<<<conto le righe nel ws1
If Ws1.Range("A" & URS).Value <> "" Then AnnoA = Year(Ws1.Range("A" & URS).Value) '<<< controllo l'anno dell'archivio
For annoweb = AnnoA To Year(Now) '<<< ciclo dall'anno archivio all'anno attuale
    Ws3.Select   '<<<<<<<<<<< da qui in poi è un classico codice QueryWeb registrato su un sito noto e scrive su Foglio "Appoggio"
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.lottoconsult.it/estrazioni_lotto.asp?anno=" & annoweb, Destination:=Range("A1"))
        .Name = "estrazioni_lotto.asp?anno=" & annoweb
        .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 = "7,8"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Rows("1:2").Select
    Selection.Delete Shift:=xlUp
   
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    UR3 = Ws3.Range("A" & Rows.Count).End(xlUp).Row
    UR4 = Ws4.Range("A" & Rows.Count).End(xlUp).Row
    For Cdata = 1 To UR3   '<<<< questo ciclo standardizza la data nel foglio "Appoggio"
        Range("A" & Cdata).Value = Format(Mid(Range("A" & Cdata).Value, 6, 15), "MM/DD/yyyy")
    Next Cdata
    If annoweb < 2005 Then  '<<<< nel 2005 è subentrata la Ruota Nazionale pertanto inserisce 5 colonne se l'anno è minore di 2005
        Columns("B:B").Select
        For AggC = 1 To 5
            Selection.Insert Shift:=xlToRight
        Next AggC
    End If
    Columns("B:BD").Select   <<<< seleziono le colonne e regolo la larghezza per contenere due numeri
    Selection.ColumnWidth = 2.54
    Ws3.Range("A1:BD" & UR3).Select
    Selection.Copy  '<<<< copio il range in "Appoggio" e incollo in "Appoggio2"
    Ws4.Select
    X = 1
    If UR4 = 1 Then X = 0
    Range("A" & UR4 + X).Select
    ActiveSheet.Paste
    Ws3.Select
    Range("A1:BD" & UR3).Clear
    Range("A1").Select
Next annoweb  '<<<< anno successivo deterinato dal ciclo
Ws4.Select
Call Incolonna  '<<<< chiama la macro Incolonna, vedi descrizione azioni riportate
    Range("A1").Select
    Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Incolonna()
Dim Vettore(11) As String  'dichiaro 11 vettori (le 11 ruote)
Vettore(1) = "RN"
Vettore(2) = "BA"
Vettore(3) = "CA"
Vettore(4) = "FI"
Vettore(5) = "GE"
Vettore(6) = "MI"
Vettore(7) = "NA"
Vettore(8) = "PA"
Vettore(9) = "RM"
Vettore(10) = "TO"
Vettore(11) = "VE"
UR4 = Ws4.Range("A" & Rows.Count).End(xlUp).Row   '<<<<  calcolo le righe nel foglio "Appoggio2"
URC = Ws4.Range("IV1").End(xlToLeft).Column     '<<<<  calcolo le colonne nel foglio "Appoggio2"
URS = Ws1.Range("A" & Rows.Count).End(xlUp).Row   '<<<<  calcolo le righe nel foglio "Archivio1939"
 'cancella estrazioni doppie
For CD = URS - 1 To 2 Step -1
UR4 = Ws4.Range("A" & Rows.Count).End(xlUp).Row
    Data1 = Ws1.Range("A" & CD).Value
    For CD2 = UR4 To 1 Step -1        '<<<<< mancava lo Step-1 qui
        If Ws4.Range("A" & CD2).Value = Data1 Then
            Ws4.Rows(CD2 & ":" & CD2).Delete Shift:=xlUp
            GoTo salta
        End If
    Next CD2
salta:
Next CD
'----
'<<< da qui in poi adatto quanto scaricato dal web al formato che mi occorre (web una riga per estrazione, archivio una riga per estrazione e per ruota)
    For IncR = 1 To UR4
        For IncC = 2 To URC Step 5
        ColS = 2
            DaTaE = Ws4.Cells(IncR, 1).Value
            If DaTaE = "" Then
                GoTo Esci
            End If
            Ruota = Int((IncC - 2) / 5) + 1
            RU = Vettore(Ruota)

            Ws1.Cells(URS + 1 + (IncR - 1) * 11 + Ruota, 1).Value = DaTaE
            Ws1.Cells(URS + 1 + (IncR - 1) * 11 + Ruota, 2).Value = RU
            For Cr = 1 To 5
                Ws1.Cells(URS + 1 + (IncR - 1) * 11 + Ruota, ColS + Cr).Value = Ws4.Cells(IncR, IncC + Cr - 1).Value
            Next Cr
        Next IncC
    Next IncR
'<<<<< fine conversione archivi

 qui ordino l'archivio (foglio "Archivio1939" per data e ruota
Ws1.Select
URS = Ws1.Range("A" & Rows.Count).End(xlUp).Row
Columns("A:G").Select
Application.CutCopyMode = False
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B1") _
       , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
      False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
     :=xlSortNormal

 
 'cancella estrazioni mancanti (nel caso si verificassero celle vuote
 For S = URS To 1 Step -1
    If Range("C" & S) = "" Then Rows(S & ":" & S).Delete Shift:=xlUp
Next S)

Esci:
End Sub


Ciao

EDIT: ore 00:45 del 12/08/2011 -
Chiaramente devi prima cancellare nel foglio "Archivio1939" l'intero anno 2011 (che aveva estrazioni doppie)
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: Excel, Lotto, Senza Macro !! ???

Postdi rosseaux » 11/08/11 23:58

Ok Flash....ci siamo quasi...

Pensa che mi dava errore....2 volte e tutte e 2 le volte son riuscito (incredibile) a cavarmela da solo...

la prima volta mi dava errore in queste righe:

UR4 = Ws4.Range("A" & Rows.Count).End(xlUp).Row '<<<< calcolo le righe nel foglio "Appoggio2"
URC = Ws4.Range("IV1").End(xlToLeft).Column '<<<< calcolo le colonne nel foglio "Appoggio2"
URS = Ws1.Range("A" & Rows.Count).End(xlUp).Row '<<<< calcolo le righe nel foglio "Archivio1939"



mi diceva che nessun oggetto era specificato...

e ho fatto il tentativo di copiare questo:

Set Ws1 = Worksheets("Archivio1939") '<<< setto i vari fogli evitando di ripetere worksheet("nomefoglio")
Set Ws3 = Worksheets("Appoggio")
Set Ws4 = Worksheets("Appoggio2")


dopo i Vettori...e prima della riga del Debug...

e mi è andata bene...ho ragionato che essendo un'altra macro dovevo settare anche lì i worksheet...

poi....mi ha dato un problema inerente alla grandezza delle colonne...

allora ho settato tutte e 7 le colonne dell'archivio storico a 8 di larghezza...

e finalmente è riuscito nell'aggiornamento totale...

però c'è un problema...

Se Nascondo "Appoggio" e "Appoggio2" ...

se premo il tasto per aggiornare mi dà questo problema:

Errore di run-time '1004'
Errore nel metodo Select per la classe Worksheet


e mi rimanda a questa riga il Debug...

Ws3.Select '<<<<<<<<<<< da qui in poi è un classico codice QueryWeb registrato su un sito noto e scrive su Foglio "Appoggio"

c'è da dire che io li vorrei nascosti i fogli "Appoggio" e "Appoggio2" ...

si può fare qualcosa anche per questo ????

intanto ti posto il codice come ce l'ho ora nel VBA...

Codice: Seleziona tutto
Sub CreaArchDaWeb()
Application.ScreenUpdating = False
Application.Calculation = xlManual
AnnoA = 1939 '<<<<assegno il primo anno ufficiale lotto
Set Ws1 = Worksheets("Archivio1939")  '<<< setto i vari fogli evitando di ripetere worksheet("nomefoglio")
Set Ws3 = Worksheets("Appoggio")
Set Ws4 = Worksheets("Appoggio2")
URS = Ws1.Range("A" & Rows.Count).End(xlUp).Row '<<<<<conto le righe nel ws1
If Ws1.Range("A" & URS).Value <> "" Then AnnoA = Year(Ws1.Range("A" & URS).Value) '<<< controllo l'anno dell'archivio
For annoweb = AnnoA To Year(Now) '<<< ciclo dall'anno archivio all'anno attuale
    Ws3.Select   '<<<<<<<<<<< da qui in poi è un classico codice QueryWeb registrato su un sito noto e scrive su Foglio "Appoggio"
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.lottoconsult.it/estrazioni_lotto.asp?anno=" & annoweb, Destination:=Range("A1"))
        .Name = "estrazioni_lotto.asp?anno=" & annoweb
        .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 = "7,8"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Rows("1:2").Select
    Selection.Delete Shift:=xlUp
   
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    UR3 = Ws3.Range("A" & Rows.Count).End(xlUp).Row
    UR4 = Ws4.Range("A" & Rows.Count).End(xlUp).Row
    For Cdata = 1 To UR3   '<<<< questo ciclo standardizza la data nel foglio "Appoggio"
        Range("A" & Cdata).Value = Format(Mid(Range("A" & Cdata).Value, 6, 15), "MM/DD/yyyy")
    Next Cdata
    If annoweb < 2005 Then  '<<<< nel 2005 è subentrata la Ruota Nazionale pertanto inserisce 5 colonne se l'anno è minore di 2005
        Columns("B:B").Select
        For AggC = 1 To 5
            Selection.Insert Shift:=xlToRight
        Next AggC
    End If
    Columns("B:BD").Select   '<<<< seleziono le colonne e regolo la larghezza per contenere due numeri
    Selection.ColumnWidth = 2.54
    Ws3.Range("A1:BD" & UR3).Select
    Selection.Copy  '<<<< copio il range in "Appoggio" e incollo in "Appoggio2"
    Ws4.Select
    X = 1
    If UR4 = 1 Then X = 0
    Range("A" & UR4 + X).Select
    ActiveSheet.Paste
    Ws3.Select
    Range("A1:BD" & UR3).Clear
    Range("A1").Select
Next annoweb  '<<<< anno successivo deterinato dal ciclo
Ws4.Select
Call Incolonna  '<<<< chiama la macro Incolonna, vedi descrizione azioni riportate
    Range("A1").Select
    Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Incolonna()
Dim Vettore(11) As String  'dichiaro 11 vettori (le 11 ruote)
Vettore(1) = "RN"
Vettore(2) = "BA"
Vettore(3) = "CA"
Vettore(4) = "FI"
Vettore(5) = "GE"
Vettore(6) = "MI"
Vettore(7) = "NA"
Vettore(8) = "PA"
Vettore(9) = "RM"
Vettore(10) = "TO"
Vettore(11) = "VE"
Set Ws1 = Worksheets("Archivio1939")  '<<< setto i vari fogli evitando di ripetere worksheet("nomefoglio")
Set Ws3 = Worksheets("Appoggio")
Set Ws4 = Worksheets("Appoggio2")
UR4 = Ws4.Range("A" & Rows.Count).End(xlUp).Row   '<<<<  calcolo le righe nel foglio "Appoggio2"
URC = Ws4.Range("IV1").End(xlToLeft).Column     '<<<<  calcolo le colonne nel foglio "Appoggio2"
URS = Ws1.Range("A" & Rows.Count).End(xlUp).Row   '<<<<  calcolo le righe nel foglio "Archivio1939"
 'cancella estrazioni doppie
For CD = URS - 1 To 2 Step -1
UR4 = Ws4.Range("A" & Rows.Count).End(xlUp).Row
    Data1 = Ws1.Range("A" & CD).Value
    For CD2 = UR4 To 1 Step -1        '<<<<< mancava lo Step-1 qui
        If Ws4.Range("A" & CD2).Value = Data1 Then
            Ws4.Rows(CD2 & ":" & CD2).Delete Shift:=xlUp
            GoTo salta
        End If
    Next CD2
salta:
Next CD
'----
'<<< da qui in poi adatto quanto scaricato dal web al formato che mi occorre (web una riga per estrazione, archivio una riga per estrazione e per ruota)
    For IncR = 1 To UR4
        For IncC = 2 To URC Step 5
        ColS = 2
            DaTaE = Ws4.Cells(IncR, 1).Value
            If DaTaE = "" Then
                GoTo Esci
            End If
            Ruota = Int((IncC - 2) / 5) + 1
            RU = Vettore(Ruota)

            Ws1.Cells(URS + 1 + (IncR - 1) * 11 + Ruota, 1).Value = DaTaE
            Ws1.Cells(URS + 1 + (IncR - 1) * 11 + Ruota, 2).Value = RU
            For Cr = 1 To 5
                Ws1.Cells(URS + 1 + (IncR - 1) * 11 + Ruota, ColS + Cr).Value = Ws4.Cells(IncR, IncC + Cr - 1).Value
            Next Cr
        Next IncC
    Next IncR
'<<<<< fine conversione archivi

 'qui ordino l'archivio (foglio "Archivio1939" per data e ruota)
Ws1.Select
URS = Ws1.Range("A" & Rows.Count).End(xlUp).Row
Columns("A:G").Select
Application.CutCopyMode = False
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B1") _
       , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
      False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
     :=xlSortNormal

 
'cancella estrazioni mancanti (nel caso si verificassero celle vuote)
 For S = URS To 1 Step -1
    If Range("C" & S) = "" Then Rows(S & ":" & S).Delete Shift:=xlUp
Next S

Esci:
End Sub


che ne pensi ??? Dai per essere alle prime armi....le 2 volte che me la son cavata da solo coi problemi in questa macro....non son stato poi così male eh... :lol: :lol: ;)
rosseaux
Utente Senior
 
Post: 151
Iscritto il: 06/01/07 14:11
Località: Alfonsine (RA)

Re: Excel, Lotto, Senza Macro !! ???

Postdi Flash30005 » 12/08/11 00:48

Mi fai tornare alla mente la storiella dei tre laureandi in Medicina che all'esame di chirurgia
l'esaminatore disse loro:
per divenire medici chirurgici bisogna essere dotati di due cose:
"Fegato" e "Occhio Clinico"...
(la fine della storiella te la racconterò in un altro momento se non la conosci)

Devo dire che tu hai "Fegato"! :D
perché penso che, nella sostituzione delle macro, abbia sovrascritto anche la Public che era all'inizio del modulo e che non andava cancellata 8)
Public rende le variabili, una volta dichiarate, "pubbliche": riconosciute in tutte le macro e in tutti i moduli della cartella excel (file)
-------
Per quanto riguarda i fogli nascosti li devi rendere visibili prima del loro utilizzo e dopo averli dichiarati con le righe
Set...
inserirai quindi sotto queste prime righe, il segente codice
Codice: Seleziona tutto
    Ws3.Visible = True
    Ws4.Visible = True


Alla fine della macro, prima dell'aggiornamento delle schermate (Application.ScreenUpdating = True)
inserirai
Codice: Seleziona tutto
    Ws3.Visible = False
    Ws4.Visible = False

per nasconderli

Se riesci da solo Ok altrimenti posta ancora
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: Excel, Lotto, Senza Macro !! ???

Postdi ricky53 » 12/08/11 01:25

Ciao Rosseaux,
leggi quanto ti ha scritto Flash (Ciao).

Ti invio un altro modo (alternativo rispetto a quello di Flash) per proteggere un foglio ma consentire, comunque, alle macro di scrivere nelle celle:
Codice: Seleziona tutto
Private Sub Workbook_Open()
    Worksheets("Appoggio").Protect UserInterFaceOnly:=True
    Worksheets("Appoggio2").Protect UserInterFaceOnly:=True
End Sub


ATTENZIONE: il codice va copiato in "ThisWorkbook" !!!
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: Excel, Lotto, Senza Macro !! ???

Postdi rosseaux » 12/08/11 01:59

Haaaallleluuuuujaaaaa !!!!!

Finalmente ora Funzia alla Grande...

Ti Posto il codice:

Codice: Seleziona tutto
Sub CreaArchDaWeb()
Application.ScreenUpdating = False
Application.Calculation = xlManual
AnnoA = 1939 '<<<<assegno il primo anno ufficiale lotto
Set Ws1 = Worksheets("Archivio1939")  '<<< setto i vari fogli evitando di ripetere worksheet("nomefoglio")
Set Ws3 = Worksheets("Appoggio")
Set Ws4 = Worksheets("Appoggio2")
Ws3.Visible = True
Ws4.Visible = True
URS = Ws1.Range("A" & Rows.Count).End(xlUp).Row '<<<<<conto le righe nel ws1
If Ws1.Range("A" & URS).Value <> "" Then AnnoA = Year(Ws1.Range("A" & URS).Value) '<<< controllo l'anno dell'archivio
For annoweb = AnnoA To Year(Now) '<<< ciclo dall'anno archivio all'anno attuale
    Ws3.Select   '<<<<<<<<<<< da qui in poi è un classico codice QueryWeb registrato su un sito noto e scrive su Foglio "Appoggio"
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.lottoconsult.it/estrazioni_lotto.asp?anno=" & annoweb, Destination:=Range("A1"))
        .Name = "estrazioni_lotto.asp?anno=" & annoweb
        .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 = "7,8"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Rows("1:2").Select
    Selection.Delete Shift:=xlUp
   
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    UR3 = Ws3.Range("A" & Rows.Count).End(xlUp).Row
    UR4 = Ws4.Range("A" & Rows.Count).End(xlUp).Row
    For Cdata = 1 To UR3   '<<<< questo ciclo standardizza la data nel foglio "Appoggio"
        Range("A" & Cdata).Value = Format(Mid(Range("A" & Cdata).Value, 6, 15), "MM/DD/yyyy")
    Next Cdata
    If annoweb < 2005 Then  '<<<< nel 2005 è subentrata la Ruota Nazionale pertanto inserisce 5 colonne se l'anno è minore di 2005
        Columns("B:B").Select
        For AggC = 1 To 5
            Selection.Insert Shift:=xlToRight
        Next AggC
    End If
    Columns("B:BD").Select   '<<<< seleziono le colonne e regolo la larghezza per contenere due numeri
    Selection.ColumnWidth = 2.54
    Ws3.Range("A1:BD" & UR3).Select
    Selection.Copy  '<<<< copio il range in "Appoggio" e incollo in "Appoggio2"
    Ws4.Select
    X = 1
    If UR4 = 1 Then X = 0
    Range("A" & UR4 + X).Select
    ActiveSheet.Paste
    Ws3.Select
    Range("A1:BD" & UR3).Clear
    Range("A1").Select
Next annoweb  '<<<< anno successivo deterinato dal ciclo
Ws4.Select
Call Incolonna  '<<<< chiama la macro Incolonna, vedi descrizione azioni riportate
    Range("A1").Select
    Application.ScreenUpdating = True
Ws3.Visible = False
Ws4.Visible = False
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Incolonna()
Dim Vettore(11) As String  'dichiaro 11 vettori (le 11 ruote)
Vettore(1) = "RN"
Vettore(2) = "BA"
Vettore(3) = "CA"
Vettore(4) = "FI"
Vettore(5) = "GE"
Vettore(6) = "MI"
Vettore(7) = "NA"
Vettore(8) = "PA"
Vettore(9) = "RM"
Vettore(10) = "TO"
Vettore(11) = "VE"
Set Ws1 = Worksheets("Archivio1939")  '<<< setto i vari fogli evitando di ripetere worksheet("nomefoglio")
Set Ws3 = Worksheets("Appoggio")
Set Ws4 = Worksheets("Appoggio2")
UR4 = Ws4.Range("A" & Rows.Count).End(xlUp).Row   '<<<<  calcolo le righe nel foglio "Appoggio2"
URC = Ws4.Range("IV1").End(xlToLeft).Column     '<<<<  calcolo le colonne nel foglio "Appoggio2"
URS = Ws1.Range("A" & Rows.Count).End(xlUp).Row   '<<<<  calcolo le righe nel foglio "Archivio1939"
 'cancella estrazioni doppie
For CD = URS - 1 To 2 Step -1
UR4 = Ws4.Range("A" & Rows.Count).End(xlUp).Row
    Data1 = Ws1.Range("A" & CD).Value
    For CD2 = UR4 To 1 Step -1        '<<<<< mancava lo Step-1 qui
        If Ws4.Range("A" & CD2).Value = Data1 Then
            Ws4.Rows(CD2 & ":" & CD2).Delete Shift:=xlUp
            GoTo salta
        End If
    Next CD2
salta:
Next CD
'----
'<<< da qui in poi adatto quanto scaricato dal web al formato che mi occorre (web una riga per estrazione, archivio una riga per estrazione e per ruota)
    For IncR = 1 To UR4
        For IncC = 2 To URC Step 5
        ColS = 2
            DaTaE = Ws4.Cells(IncR, 1).Value
            If DaTaE = "" Then
                GoTo Esci
            End If
            Ruota = Int((IncC - 2) / 5) + 1
            RU = Vettore(Ruota)

            Ws1.Cells(URS + 1 + (IncR - 1) * 11 + Ruota, 1).Value = DaTaE
            Ws1.Cells(URS + 1 + (IncR - 1) * 11 + Ruota, 2).Value = RU
            For Cr = 1 To 5
                Ws1.Cells(URS + 1 + (IncR - 1) * 11 + Ruota, ColS + Cr).Value = Ws4.Cells(IncR, IncC + Cr - 1).Value
            Next Cr
        Next IncC
    Next IncR
'<<<<< fine conversione archivi

 'qui ordino l'archivio (foglio "Archivio1939" per data e ruota)
Ws1.Select
URS = Ws1.Range("A" & Rows.Count).End(xlUp).Row
Columns("A:G").Select
Application.CutCopyMode = False
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B1") _
       , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
      False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
     :=xlSortNormal

 
'cancella estrazioni mancanti (nel caso si verificassero celle vuote)
 For S = URS To 1 Step -1
    If Range("C" & S) = "" Then Rows(S & ":" & S).Delete Shift:=xlUp
Next S

Esci:
End Sub


Comunque non vorrei insistere...ma sono quasi convinto che questo comando "Public" io non l'abbia cancellato....

se noti nella Macro che mi hai scritto quì sopra all'inizio di questa seconda pagina del mio post.....non è presente quel comando...

come funzionerebbe di preciso ??? Tipo:

Codice: Seleziona tutto
Public Incolonna()


???

Eh no però io il finale della storia lo vorrei sapere eh... :lol: :lol: :lol:

Comunque sei veramente un Grande Flash !!!!

ricky53 ti ringrazio per il tuo intervento... !!!

solo che non mi è chiaro cosa intendi quando mi dici di copiarlo in "ThisWorkBook" !!!
rosseaux
Utente Senior
 
Post: 151
Iscritto il: 06/01/07 14:11
Località: Alfonsine (RA)

Re: Excel, Lotto, Senza Macro !! ???

Postdi ricky53 » 12/08/11 14:50

Ciao,
volevo dirti di non copiarlo in un "Modulo" ma aprendo l'editor del VB, in VBAProject trovi "ThisWorbook" (per il 2003)o "Questa_Cartella_di_Lavoro" (per il 2007 e il 2010) ...
Adesso è più chiaro ?
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: Excel, Lotto, Senza Macro !! ???

Postdi rosseaux » 12/08/11 15:45

ah siiii.. !!!!

...Grazie ricky53 !!!! ;) ;) ;)
rosseaux
Utente Senior
 
Post: 151
Iscritto il: 06/01/07 14:11
Località: Alfonsine (RA)

Re: Excel, Lotto, Senza Macro !! ???

Postdi Flash30005 » 12/08/11 22:58

Non avendo capito se hai risolto con public o con esempio Richy (che saluto cordialmente)
procedo con il seguito della storiella... (non mi piace lasciare le cose a metà) :D
I tre laurenadi si trovarono davanti a un cadavere su una lettiga
e l'esaminatore girò sottosopra mettendolo con il volto sulla lettiga e quindi era visibile di spalle e... resto.
Disse loro:
"adesso fate attenzione a ciò che faccio io"
infilò un dito nell'ano del cadavere
si portò la mano vicino al volto e mise un dito nella sua bocca succhiando il dito.
"adesso dimostratemi che siete dei potenziali e futuri medici chirurgici facendo la stessa cosa"
il primo chiuse gli occhi... ma ... si rifiutò, e se ne andò.
Il secondo infilò il dito nell'organo ma quando pensò che doveva metterlo in bocca, beh ... lo stomaco non resse... e potete capire cosa successe.
Il terzo, con molto coraggio, infilò il dito e se lo portò in bocca (succhiandolo).
L'esaminatore disse:
"ehmmm, bravo! noto che hai fegato ma... non occhio clicnico!
infatti io ho infilato nell'ano il dito medio e mi sono messo in bocca l'indice"
:lol: :lol: :lol:
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: Excel, Lotto, Senza Macro !! ???

Postdi rosseaux » 13/08/11 09:44

ahahahahahhah.....Ecco perchè mi dicevi che avevo Fegato....ahahaha...

no vabè comunque il fatto del Public era semplice curiosità....cioè se avessi dovuto mettere sto Public....come lo avrei dovuto utilizzare ??? ;)
rosseaux
Utente Senior
 
Post: 151
Iscritto il: 06/01/07 14:11
Località: Alfonsine (RA)

Re: Excel, Lotto, Senza Macro !! ???

Postdi Flash30005 » 13/08/11 21:15

Se hai ancora il file scaricato dal mio post (file con il bug)
troverai il Public all'inizio del modulo dove ci sono le macro
e in quel file avresti dovuto sostituire solo le macro e non la dichiarazione fatta in Public
(che doveva rimanere nello stesso punto)

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: Excel, Lotto, Senza Macro !! ???

Postdi rosseaux » 13/08/11 23:12

Guarda Flash....io non vorrei insistere...però questo comando Public...nel file che hai compilato Te.....non c'è....ci ho guardato bene....

non saprèi....forse cerco nel posto sbagliato...

io ho guardato proprio all'inizio della macro.... :-? :-? :mmmh:
rosseaux
Utente Senior
 
Post: 151
Iscritto il: 06/01/07 14:11
Località: Alfonsine (RA)

Re: Excel, Lotto, Senza Macro !! ???

Postdi ricky53 » 13/08/11 23:37

Ciao,
scusate se mi intrometto.

Rosseaux: nel file di Flash (una grosso CIAO) se vai nel "Modulo2" troverai
Codice: Seleziona tutto
Public Ws1, Ws2, Ws3, Ws4 As Worksheet
Sub TRovaNTest()
...
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: Excel, Lotto, Senza Macro !! ???

Postdi sangennarosan » 14/08/11 09:38

ricky53 ha scritto:Ciao,
scusate se mi intrometto.

Rosseaux: nel file di Flash (una grosso CIAO) se vai nel "Modulo2" troverai
Codice: Seleziona tutto
Public Ws1, Ws2, Ws3, Ws4 As Worksheet
Sub TRovaNTest()
...


Si, confermo... anche io continuavo a cercare nel MODULO1
sangennarosan
Utente Junior
 
Post: 16
Iscritto il: 27/07/11 17:32

Re: Excel, Lotto, Senza Macro !! ???

Postdi rosseaux » 14/08/11 10:02

ahhhhhh Cavolo....Grazie Ricky e Sangennarosan !!! ma dal modulo2 vale anche per il modulo1 questa funzione ???....o andrebbe rimessa anche nel modulo1 per farla valere ??? ;)
rosseaux
Utente Senior
 
Post: 151
Iscritto il: 06/01/07 14:11
Località: Alfonsine (RA)

Re: Excel, Lotto, Senza Macro !! ???

Postdi sangennarosan » 14/08/11 11:16

Non essendo un mago in VB, presumo che:
poiche e' una dichiarazione PUBBLICA di alcuni WORKSHEET ... funzioni in qualsiasi modulo...ma l'importante e' che ci sia
sangennarosan
Utente Junior
 
Post: 16
Iscritto il: 27/07/11 17:32

Re: Excel, Lotto, Senza Macro !! ???

Postdi ricky53 » 14/08/11 13:17

Ciao Rossaaux,
Consiglio: leggi con maggiore attenzione quanto viene scritto da tutti noi.

La tua ultima domanda aveva già avuto una risposta prima che tu la ponessi, infatti:
Flash ha scritto:Public rende le variabili, una volta dichiarate, "pubbliche": riconosciute in tutte le macro e in tutti i moduli della cartella excel (file)


Ciao
e ...
Buon proseguimento
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: Excel, Lotto, Senza Macro !! ???

Postdi Flash30005 » 14/08/11 14:35

rosseaux ha scritto:ahhhhhh Cavolo....Grazie Ricky e Sangennarosan !!! ma dal modulo2 vale anche per il modulo1 questa funzione ???....o andrebbe rimessa anche nel modulo1 per farla valere ??? ;)

:roll:

Continui ad agire senza usare "l'occhio clinico" (prestare attenzione)
avevo scritto il 12/08/11 ore 01:48 :
Flash30005 ha scritto:Public rende le variabili, una volta dichiarate, "pubbliche": riconosciute in tutte le macro e in tutti i moduli della cartella excel (file)



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-

PrecedenteProssimo

Torna a Applicazioni Office Windows


Topic correlati a "Excel, Lotto, Senza Macro !! ???":


Chi c’è in linea

Visitano il forum: Nessuno e 33 ospiti