Condividi:        

[Excel]Query Web+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

[Excel]Query Web+Macro

Postdi dragonedellenuvole » 01/10/10 22:52

Ciao ragazzi mi sono appena inscritto al forum, e vorrei presentare un problema che mi si è verificato con excel nell importazione di tabelle dal web e le macro.Vi spiego passo passo quello che io dovrei fare e se secondo voi c'è una soluzione partendo dal presupposto che non sn un genio in programmazione macro.

Il mio scopo è prelevare dal sito http://www.borsaitaliana.it/borsa/azioni/contratti.html?isin=IT0000064854&lang=it tutti i contratti di quel titolo di borsa cioè la tabella contenete ora prezzo ultimo contratto var% volume ultimo volume totale, la cosa non è molto difficile usanto l importazione query web da excel il problema nasce perche devo importare anche la seconda pagina ovvero http://www.borsaitaliana.it/borsa/azioni/contratti.html?isin=IT0000064854&page=1 in successione alla prima e così via finchè non finiscono le pagine. Secondo voi c'è una possibile soluzione al problema..Ringrazio Anticipatamente
dragonedellenuvole
Utente Junior
 
Post: 16
Iscritto il: 01/10/10 22:32

Sponsor
 

Re: [Excel]Query Web+Macro

Postdi Anthony47 » 01/10/10 23:22

Ciao dragonedellenuvole e benvenuto nel forum.
Prova a registrarti una macro mentre fai la prima query in modo soddisfacente; poi inserisci questo codice in un Do /Loop da cui esci quando nell' ultima posizione il Volume ultimo e' pari a Volume totale.
Nella macro inserirai un contatore I che partendo da 0 fai incrementare a fine di ogni query, e usi questo contatore per comporre il vero indirizzo di query, che sara'
Codice: Seleziona tutto
"URL;http://www.borsaitaliana.it/borsa//azioni/contratti.html?isin=IT0000064854&page=" & I

In quanto a Destination, essa sara'
Codice: Seleziona tutto
Destination:=Cells(rows.count,1).End(XLup).Offset(1,0)
in modo da accodare i nuovi dati ai precedenti.

Se hai problemi a impostare il tutto posta ancora spiegando dove sei arrivato.

Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel]Query Web+Macro

Postdi dragonedellenuvole » 02/10/10 11:04

Anthony47 ha scritto:Ciao dragonedellenuvole e benvenuto nel forum.
Prova a registrarti una macro mentre fai la prima query in modo soddisfacente; poi inserisci questo codice in un Do /Loop da cui esci quando nell' ultima posizione il Volume ultimo e' pari a Volume totale.
Nella macro inserirai un contatore I che partendo da 0 fai incrementare a fine di ogni query, e usi questo contatore per comporre il vero indirizzo di query, che sara'
Codice: Seleziona tutto
"URL;http://www.borsaitaliana.it/borsa//azioni/contratti.html?isin=IT0000064854&page=" & I

In quanto a Destination, essa sara'
Codice: Seleziona tutto
Destination:=Cells(rows.count,1).End(XLup).Offset(1,0)
in modo da accodare i nuovi dati ai precedenti.

Se hai problemi a impostare il tutto posta ancora spiegando dove sei arrivato.

Ciao.



Grazie Anthony per la risp. Il problema è che con le macro non vado molto daccoro :lol: ..... questo il codice della prima pagina
Codice: Seleziona tutto
Sub Macro1()
'
' Macro1 Macro
'

'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.borsaitaliana.it/borsa/azioni/contratti.html?isin=IT0000064854&lang=it" _
        , Destination:=Range("$A$1"))
        .Name = "contratti.html?isin=IT0000064854&lang=it"
        .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
End Sub


Per mettere la seconda dovrei cliccare sull' ultima cella vuota e inserire una nuova macro e così via con tutte le altre...E' un lavoro molto dipsendioso, e non sono certo nemmeno quante sono le pagine, perchè un giorno possono essere 50 l' altro giorno che il titolo fa più volumi possono essere 70... :cry:
dragonedellenuvole
Utente Junior
 
Post: 16
Iscritto il: 01/10/10 22:32

Re: [Excel]Query Web+Macro

Postdi Flash30005 » 02/10/10 15:02

Ciao Dragonedellenuvole e benvenuto anche da parte mia

Prova questa macro

Codice: Seleziona tutto
Sub DatiQuery()
Application.ScreenUpdating = False
Application.Calculation = xlManual
    Cells.Clear
    On Error Resume Next
    Selection.QueryTable.Delete
    On Error GoTo 0
    Range("A1").Select
UR = 1
For Rip = 1 To 1000
If Rip = 465 Then MsgBox Rip
If Rip = 1 Then
Pag = ""
Pag2 = "lang=it"
Else
Pag = Rip - 1
Pag2 = "page=" & Pag
End If
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.borsaitaliana.it/borsa/azioni/contratti.html?isin=IT0000064854&" & Pag2 _
        , Destination:=Range("A" & UR))
        .Name = "contratti.html?isin=IT0000064854&" & Pag2
        .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
    UR = Worksheets("Foglio1").Range("A" & Rows.Count).End(xlUp).Row + 1
    If Range("A" & UR - 1).Text = "Ora" Then GoTo Salta
    Range("A" & UR).Select
Next Rip
Salta:
URC = Worksheets("Foglio1").Range("A" & Rows.Count).End(xlUp).Row
For RC = URC To 2 Step -1
If Range("A" & RC).Text = "Ora" Then Rows(RC & ":" & RC).Delete
Next RC
 Range("A1").Select
 Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Il foglio dovrà chiamarsi (almeno per il momento) Foglio1
Per 467 pagine occorrono circa 10 minuti.
Se prevedi più di 1000 pagine puoi cambiare il valore nel ciclo For...next
(non comporterà, comunque, un aumento dei tempi di elaborazione a parità di pagine)
Codice: Seleziona tutto
For Rip = 1 To 1000 '<<<< cambiare questo valore


Fai 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: [Excel]Query Web+Macro

Postdi dragonedellenuvole » 02/10/10 22:09

Flash sei un grande..... Funziona benissimo...Siete fantastici :) :) ...Altro piccolo quesito: Dovrei scaricare un bel pò di titoli conviene scaricarli in fogli separati o in cartelle di lavoro separati per evitare sovraccarico di dati? :?:
dragonedellenuvole
Utente Junior
 
Post: 16
Iscritto il: 01/10/10 22:32

Re: [Excel]Query Web+Macro

Postdi Flash30005 » 02/10/10 22:45

Non è tanto il sovraccarico (che in eccesso potrebbe dare problemi di lentezza)
ma soprattutto perché ogni titolo avrà un suo indice di pagina web
vedi questo utilizzato precedentemente
...html?isin=IT0000064854&"
quel numero è riferito al titolo
pertanto dovrai avere una query per ogni titolo
e un foglio per ogni titolo
A questo punto penso sia meglio, se non hai problemi per la consultazione,
avere un file (cartella di excel) con il nome del titolo e quindi per ogni titolo,
tutti questi file contenuti in una unica cartella (directory di windows)
e avere in un file un elenco dei titoli (dei file contenuti in quella cartella)
da questo elenco aprire questo o quel titolo.
L'elenco chiaramente aggiornabile.

Cosa ne pensi?
Ciao

P.s. per fare quanto detto non devi far altro che copiare più volte il file funzionate e sostituire nella macro il codice
IT0000064854 inserendo quello che trovi nella barra del browser una volta raggiunto il titolo desiderato
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]Query Web+Macro

Postdi dragonedellenuvole » 02/10/10 22:55

Io sugli archivi che scarico ci devo andare a fare delle operazioni e poi li posso cancellare,quindi potrei fare se è possibile un file di controllo su tutti gli altri...Vorrei usare dei file per l ' archivio e 1 file per prelevare le informazioni con il risultato finale...nn so se mi sn spiegato e se è possibile farlo :P
dragonedellenuvole
Utente Junior
 
Post: 16
Iscritto il: 01/10/10 22:32

Re: [Excel]Query Web+Macro

Postdi Flash30005 » 02/10/10 23:22

Mi sembra abbastanza chiaro ciò che vuoi fare e credo fattibile
Con ciò che ho letto su questo Forum
posso dire che è fattibile quasi tutto ;)

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]Query Web+Macro

Postdi Anthony47 » 02/10/10 23:24

Mi permetto di modificare la macro di Flash in questo modo:
Codice: Seleziona tutto
Sub DatiQuery()
Application.ScreenUpdating = False
Application.Calculation = xlManual
Cells.Select
Selection.Clear
    On Error Resume Next
Selection.QueryTable.Delete
    On Error GoTo 0
Range("A1").Select
UR = 1
[Z1] = Timer
For Rip = 0 To 1000
    For Each RName In ThisWorkbook.Names
        RName.Delete
    Next RName

With ActiveSheet.QueryTables.Add(Connection:= _
            "URL;http://www.borsaitaliana.it/borsa/azioni/contratti.html?isin=IT0000064854&page=" & Rip _
            , Destination:=Range("A" & UR))
            .Name = "contratti.html?isin=IT0000064854&"
            .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
       
        UR = Worksheets("Foglio1").Range("A" & Rows.Count).End(xlUp).Row + 1
        If Range("A" & UR - 1).Text = "Ora" Then
            If UR > 1 And Range("A" & UR-1).Text = "Ora" Then Rows(UR-1 & ":" & UR-1).Delete
            GoTo Salta
        End If
    If UR > 1 And Range("A" & UR).Text = "Ora" Then Rows(UR & ":" & UR).Delete
    Range("A" & UR).Select
Next Rip
Salta:
    Range("A1").Select
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
[Z2] = Timer
    End Sub

La variazione principale consiste nella cancellazione di tutti gli intervalli definiti al mommento delle "QueryTables.Add", che a lungo andare avrebbero potuto dare qualche problema; ho poi semplificato il meccanismo di calcolo dell' URL, e cancello le righe di intestazione direttamente al completamento delle query non alla fine.
Ho mantenuto lo schema del For Rip /Next Rip, invece di suggerire un piu' ortodosso Do / Exit Do /Loop, per avere in ogni caso una uscita forzata dopo 1000 cicli di query indipendentemente dall' identificazione di un ciclo "vuoto" sinonimo "presunto" di fine.

Quanto alla richiesta di lavorare su un elenco di titoli, il mio suggerimento e' di lavorare su un "Foglio Indice", che in una colonna contiene l' elenco dei titoli e accanto il foglio in cui effettuare l' acquisizione dati.
La struttura della macro rimane la stessa, ma va inserita in un ulteriore ciclo For /Next dove viene letto il titolo, consequentemente si seleziona il relativo Foglio, si continua con il codice di adesso, prima di End Sub si inserisce il Next del ciclo aggiunto.

Per il calcolo dell' URL non si usera'
"URL;http://www.borsaitaliana.it/borsa/azioni/contratti.html?isin=IT0000064854&page=" & Rip ma una cosa appena piu' complessa, cioe'
Codice: Seleziona tutto
"URL;http://www.borsaitaliana.it/borsa/azioni/contratti.html?isin=" & MyISIN & "&page=" & Rip

Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel]Query Web+Macro

Postdi dragonedellenuvole » 03/10/10 13:48

Allego il file per far capire meglio cosa devo fare, premetto che quando il file sarà finito lo metterò a beneficio di tutto il forum. Magari a qlcn potrà servire :) http://www.fileden.com/files/2010/4/1/2813746//A.xlsm
dragonedellenuvole
Utente Junior
 
Post: 16
Iscritto il: 01/10/10 22:32

Re: [Excel]Query Web+Macro

Postdi dragonedellenuvole » 03/10/10 13:53

Anche se il file è .zip aprendolo con excel funziona. ;)
dragonedellenuvole
Utente Junior
 
Post: 16
Iscritto il: 01/10/10 22:32

Re: [Excel]Query Web+Macro

Postdi Anthony47 » 03/10/10 16:05

Piu' che "scombussolarti tutto" direi che cancella e riparte daccapo.
1, non devi fare Cells.Clear ma devi cancellare solo le colonne interessate dalla tua query.
2, devi cambiare la colonna di destinazione anche nella riga " , Destination:=Range("A" & UR))"
3, per ordinare con data crescente ti registri una macro (una per ogni titolo) mentre selezioni le colonne che ti interessano e attivi un ordinamento per VolumeTotale-Crescente; poi inserisci il codice prodotto (meno il titolo e la End sub) prima della End Sub della macro di query.

Ti ricordo che "quella" macro di web query genera una quantita' di nomi di intervalli ad ogni esecuzione, prima o poi ti daranno fastidio; per questo avevo proposto una variante. Per quanto detto al punto 1 sopra, non farai "Cells.Select" ma, ad esempio, Range("A:E").Select

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel]Query Web+Macro

Postdi dragonedellenuvole » 03/10/10 16:53

Grazie Anthony per la risp, sto provando a modificare il tuo codice, forse ho trovato la soluzione, ovvero caricare i dati piuttosto che da sinistra verso destra, da destra verso sinistra..
dragonedellenuvole
Utente Junior
 
Post: 16
Iscritto il: 01/10/10 22:32

Re: [Excel]Query Web+Macro

Postdi dragonedellenuvole » 03/10/10 16:56

Questo è il codice:

Codice: Seleziona tutto
Sub Pulsante2_Click()
Application.ScreenUpdating = False
Application.Calculation = xlManual
[b]Range("A:E").Select[/b]
    On Error Resume Next
Selection.QueryTable.Delete
    On Error GoTo 0
Range("A1").Select
UR = 1
[Z1] = Timer
For Rip = 0 To 1000
    For Each RName In ThisWorkbook.Names
        RName.Delete
    Next RName

With ActiveSheet.QueryTables.Add(Connection:= _
            "URL;http://www.borsaitaliana.it/borsa/azioni/contratti.html?isin=IT0001207098&page=" & Rip _
            , Destination:=Range("A" & UR))
            .Name = "contratti.html?isin=IT0001207098&"
            .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
       
        UR = Worksheets("A1").Range("A" & Rows.Count).End(xlUp).Row + 1
        If Range("A" & UR - 1).Text = "Ora" Then
            If UR > 1 And Range("A" & UR - 1).Text = "Ora" Then Rows(UR - 1 & ":" & UR - 1).Delete
            GoTo Salta
        End If
    If UR > 1 And Range("A" & UR).Text = "Ora" Then Rows(UR & ":" & UR).Delete
    Range("A" & UR).Select
Next Rip
Salta:
    Range("A1").Select
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
[Z2] = Timer
    End Sub
dragonedellenuvole
Utente Junior
 
Post: 16
Iscritto il: 01/10/10 22:32

Re: [Excel]Query Web+Macro

Postdi Anthony47 » 03/10/10 17:25

Manca all' inizio il "Selection.Clear".
Elimina dal codice [Z1] = Timer (verso l' inizio) e [Z2] = Timer (verso la fine); servivano solo per controllare i tempi di esecuzione.

forse ho trovato la soluzione, ovvero caricare i dati piuttosto che da sinistra verso destra, da destra verso sinistra..
Non capisco a quale problema fai riferimento (e quindi non so valutare nemmeno la soluzione che hai in mente)

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel]Query Web+Macro

Postdi dragonedellenuvole » 03/10/10 18:45

Usando il codice che ho postato, aggiunge nuove colonne a sinistra e inserisce i dati li, il problema è che mi occupa anche le colonne per le operazioni.
dragonedellenuvole
Utente Junior
 
Post: 16
Iscritto il: 01/10/10 22:32

Re: [Excel]Query Web+Macro

Postdi dragonedellenuvole » 04/10/10 20:48

Ho rinunciato a metterne più di uno nel foglio. Ho usato questa soluzione un pò complessa, ma funziona. Anthony non usato il tuo codice per scaricare i dati perchè ogni tanto sbucava fuori tra i dati, ora volume totale ecc. si accettano consigli per migliorare il progetto:
Per provarlo bisogna inserire un foglio chiamato ASROMA

Codice: Seleziona tutto
Sub ASROMA()
Application.ScreenUpdating = False
Application.Calculation = xlManual
    Cells.Clear
    On Error Resume Next
    Selection.QueryTable.Delete
    On Error GoTo 0
    Range("A1").Select
UR = 1
For Rip = 1 To 1000
If Rip = 465 Then MsgBox Rip
If Rip = 1 Then
Pag = ""
Pag2 = "lang=it"
Else
Pag = Rip - 1
Pag2 = "page=" & Pag
End If
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.borsaitaliana.it/borsa/azioni/contratti.html?isin=IT0001008876&" & Pag2 _
        , Destination:=Range("A" & UR))
        .Name = "contratti.html?isin=IT0001008876&" & Pag2
        .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
    UR = Worksheets("ASROMA").Range("A" & Rows.Count).End(xlUp).Row + 1
    If Range("A" & UR - 1).Text = "Ora" Then GoTo Salta
    Range("A" & UR).Select
Next Rip
Salta:
URC = Worksheets("ASROMA").Range("A" & Rows.Count).End(xlUp).Row
For RC = URC To 2 Step -1
If Range("A" & RC).Text = "Ora" Then Rows(RC & ":" & RC).Delete
Next RC
Range("A1").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

    Range("F1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-3]=R[1]C[-3],0,RC[-2])"
    Selection.AutoFill Destination:=Range("F1:F3"), Type:=xlFillDefault
    Range("F1:F3").Select
    Selection.AutoFill Destination:=Range("F1:F5"), Type:=xlFillDefault
    Range("F1:F5").Select
    Range("F1").Select
    Selection.AutoFill Destination:=Range("F1:F23060"), Type:=xlFillDefault
    Range("F1:F23060").Select
    ActiveWindow.SmallScroll Down:=-45
    ActiveWindow.ScrollRow = 22989
    ActiveWindow.ScrollRow = 22899
    ActiveWindow.ScrollRow = 22718
    ActiveWindow.ScrollRow = 22266
    ActiveWindow.ScrollRow = 21679
    ActiveWindow.ScrollRow = 20911
    ActiveWindow.ScrollRow = 19647
    ActiveWindow.ScrollRow = 17885
    ActiveWindow.ScrollRow = 16260
    ActiveWindow.ScrollRow = 14905
    ActiveWindow.ScrollRow = 14227
    ActiveWindow.ScrollRow = 13595
    ActiveWindow.ScrollRow = 13053
    ActiveWindow.ScrollRow = 12601
    ActiveWindow.ScrollRow = 12285
    ActiveWindow.ScrollRow = 11969
    ActiveWindow.ScrollRow = 11608
    ActiveWindow.ScrollRow = 11292
    ActiveWindow.ScrollRow = 10976
    ActiveWindow.ScrollRow = 10795
    ActiveWindow.ScrollRow = 10705
    ActiveWindow.ScrollRow = 10524
    ActiveWindow.ScrollRow = 10253
    ActiveWindow.ScrollRow = 10163
    ActiveWindow.ScrollRow = 10117
    ActiveWindow.ScrollRow = 9846
    ActiveWindow.ScrollRow = 8988
    ActiveWindow.ScrollRow = 7408
    ActiveWindow.ScrollRow = 5692
    ActiveWindow.ScrollRow = 4562
    ActiveWindow.ScrollRow = 3885
    ActiveWindow.ScrollRow = 3253
    ActiveWindow.ScrollRow = 2711
    ActiveWindow.ScrollRow = 2349
    ActiveWindow.ScrollRow = 2033
    ActiveWindow.ScrollRow = 1672
    ActiveWindow.ScrollRow = 1266
    ActiveWindow.ScrollRow = 949
    ActiveWindow.ScrollRow = 769
    ActiveWindow.ScrollRow = 588
    ActiveWindow.ScrollRow = 407
    ActiveWindow.ScrollRow = 136
    ActiveWindow.ScrollRow = 1
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-4]>R[1]C[-4],+RC[-1],-RC[-1])"
    Selection.AutoFill Destination:=Range("G1:G7"), Type:=xlFillDefault
    Range("G1:G7").Select
    Selection.AutoFill Destination:=Range("G1:G23060"), Type:=xlFillDefault
    Range("G1:G23060").Select
    ActiveWindow.SmallScroll Down:=-45
    ActiveWindow.ScrollRow = 22989
    ActiveWindow.ScrollRow = 23034
    ActiveWindow.ScrollRow = 22989
    ActiveWindow.ScrollRow = 22944
    ActiveWindow.ScrollRow = 22899
    ActiveWindow.ScrollRow = 22853
    ActiveWindow.ScrollRow = 22808
    ActiveWindow.ScrollRow = 22763
    ActiveWindow.ScrollRow = 22673
    ActiveWindow.ScrollRow = 22628
    ActiveWindow.ScrollRow = 22492
    ActiveWindow.ScrollRow = 22266
    ActiveWindow.ScrollRow = 21860
    ActiveWindow.ScrollRow = 21047
    ActiveWindow.ScrollRow = 19963
    ActiveWindow.ScrollRow = 19195
    ActiveWindow.ScrollRow = 18608
    ActiveWindow.ScrollRow = 18202
    ActiveWindow.ScrollRow = 17795
    ActiveWindow.ScrollRow = 17569
    ActiveWindow.ScrollRow = 17343
    ActiveWindow.ScrollRow = 17253
    ActiveWindow.ScrollRow = 17163
    ActiveWindow.ScrollRow = 16756
    ActiveWindow.ScrollRow = 16711
    ActiveWindow.ScrollRow = 16621
    ActiveWindow.ScrollRow = 16485
    ActiveWindow.ScrollRow = 16079
    ActiveWindow.ScrollRow = 15040
    ActiveWindow.ScrollRow = 13143
    ActiveWindow.ScrollRow = 11247
    ActiveWindow.ScrollRow = 9846
    ActiveWindow.ScrollRow = 8808
    ActiveWindow.ScrollRow = 8040
    ActiveWindow.ScrollRow = 7498
    ActiveWindow.ScrollRow = 7001
    ActiveWindow.ScrollRow = 6504
    ActiveWindow.ScrollRow = 6098
    ActiveWindow.ScrollRow = 5646
    ActiveWindow.ScrollRow = 5059
    ActiveWindow.ScrollRow = 4201
    ActiveWindow.ScrollRow = 2395
    ActiveWindow.ScrollRow = 2349
    ActiveWindow.ScrollRow = 2304
    ActiveWindow.ScrollRow = 2259
    ActiveWindow.ScrollRow = 2214
    ActiveWindow.ScrollRow = 2124
    ActiveWindow.ScrollRow = 2033
    ActiveWindow.ScrollRow = 1898
    ActiveWindow.ScrollRow = 1672
    ActiveWindow.ScrollRow = 1175
    ActiveWindow.ScrollRow = 588
    ActiveWindow.ScrollRow = 91
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollRow = 46
    ActiveWindow.ScrollRow = 91
    ActiveWindow.ScrollRow = 136
    ActiveWindow.ScrollRow = 182
    ActiveWindow.ScrollRow = 227
    ActiveWindow.ScrollRow = 272
    ActiveWindow.ScrollRow = 317
    ActiveWindow.ScrollRow = 362
    ActiveWindow.ScrollRow = 407
    ActiveWindow.ScrollRow = 453
    ActiveWindow.ScrollRow = 498
    ActiveWindow.ScrollRow = 543
    ActiveWindow.ScrollRow = 588
    ActiveWindow.ScrollRow = 633
    ActiveWindow.ScrollRow = 678
    ActiveWindow.ScrollRow = 724
    ActiveWindow.ScrollRow = 769
    ActiveWindow.ScrollRow = 724
    ActiveWindow.ScrollRow = 678
    ActiveWindow.ScrollRow = 633
    ActiveWindow.ScrollRow = 588
    ActiveWindow.ScrollRow = 498
    ActiveWindow.ScrollRow = 453
    ActiveWindow.ScrollRow = 362
    ActiveWindow.ScrollRow = 272
    ActiveWindow.ScrollRow = 227
    ActiveWindow.ScrollRow = 136
    ActiveWindow.ScrollRow = 91
    ActiveWindow.ScrollRow = 46
    ActiveWindow.ScrollRow = 1
    Columns("G:G").ColumnWidth = 13.86
    Windows("prova tick1.xlsx").Activate
    Range("I5").Select
    Windows("A.xlsm").Activate
    ActiveWindow.SmallScroll Down:=-18
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]>0,RC[-1],0)"
    Selection.AutoFill Destination:=Range("H1:H23060"), Type:=xlFillDefault
    Range("H1:H23060").Select
    ActiveWindow.SmallScroll Down:=-63
    ActiveWindow.ScrollRow = 22989
    ActiveWindow.ScrollRow = 22944
    ActiveWindow.ScrollRow = 22899
    ActiveWindow.ScrollRow = 22808
    ActiveWindow.ScrollRow = 22628
    ActiveWindow.ScrollRow = 22040
    ActiveWindow.ScrollRow = 20234
    ActiveWindow.ScrollRow = 17253
    ActiveWindow.ScrollRow = 14589
    ActiveWindow.ScrollRow = 12421
    ActiveWindow.ScrollRow = 10885
    ActiveWindow.ScrollRow = 9711
    ActiveWindow.ScrollRow = 8672
    ActiveWindow.ScrollRow = 7363
    ActiveWindow.ScrollRow = 5646
    ActiveWindow.ScrollRow = 3659
    ActiveWindow.ScrollRow = 1130
    ActiveWindow.ScrollRow = 1085
    ActiveWindow.ScrollRow = 995
    ActiveWindow.ScrollRow = 859
    ActiveWindow.ScrollRow = 453
    ActiveWindow.ScrollRow = 1
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-2]<0,RC[-2],0)"
    Selection.AutoFill Destination:=Range("I1:I23060"), Type:=xlFillDefault
    Range("I1:I23060").Select
    ActiveWindow.ScrollRow = 22990
    ActiveWindow.ScrollRow = 22945
    ActiveWindow.ScrollRow = 22854
    ActiveWindow.ScrollRow = 22674
    ActiveWindow.ScrollRow = 22177
    ActiveWindow.ScrollRow = 21364
    ActiveWindow.ScrollRow = 20235
    ActiveWindow.ScrollRow = 19106
    ActiveWindow.ScrollRow = 17977
    ActiveWindow.ScrollRow = 16712
    ActiveWindow.ScrollRow = 15131
    ActiveWindow.ScrollRow = 13505
    ActiveWindow.ScrollRow = 11924
    ActiveWindow.ScrollRow = 10299
    ActiveWindow.ScrollRow = 8718
    ActiveWindow.ScrollRow = 6414
    ActiveWindow.ScrollRow = 6369
    ActiveWindow.ScrollRow = 6234
    ActiveWindow.ScrollRow = 6143
    ActiveWindow.ScrollRow = 6008
    ActiveWindow.ScrollRow = 5782
    ActiveWindow.ScrollRow = 5466
    ActiveWindow.ScrollRow = 5059
    ActiveWindow.ScrollRow = 4563
    ActiveWindow.ScrollRow = 4066
    ActiveWindow.ScrollRow = 3614
    ActiveWindow.ScrollRow = 3208
    ActiveWindow.ScrollRow = 2892
    ActiveWindow.ScrollRow = 2575
    ActiveWindow.ScrollRow = 2304
    ActiveWindow.ScrollRow = 2124
    ActiveWindow.ScrollRow = 1898
    ActiveWindow.ScrollRow = 1717
    ActiveWindow.ScrollRow = 1582
    ActiveWindow.ScrollRow = 1491
    ActiveWindow.ScrollRow = 1446
    ActiveWindow.ScrollRow = 1356
    ActiveWindow.ScrollRow = 1311
    ActiveWindow.ScrollRow = 1220
    ActiveWindow.ScrollRow = 1130
    ActiveWindow.ScrollRow = 1085
    ActiveWindow.ScrollRow = 1040
    ActiveWindow.ScrollRow = 995
    ActiveWindow.ScrollRow = 949
    ActiveWindow.ScrollRow = 904
    ActiveWindow.ScrollRow = 814
    ActiveWindow.ScrollRow = 724
    ActiveWindow.ScrollRow = 678
    ActiveWindow.ScrollRow = 543
    ActiveWindow.ScrollRow = 407
    ActiveWindow.ScrollRow = 272
    ActiveWindow.ScrollRow = 1
    Range("K12:L12").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    ActiveCell.FormulaR1C1 = "Vol Acq"
    Range("M12:N12").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    ActiveCell.FormulaR1C1 = "Vol Vend"
    Range("K13:L13").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("K12:N13").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("M13:N13").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("K14:N14").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("L15:M15").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("K14:N14").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("L15:M15").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("K13:L13").Select
    ActiveCell.FormulaR1C1 = "=SUM(C[-3])"
    Range("M13:N13").Select
    ActiveCell.FormulaR1C1 = "=SUM(C[-4])"
    Range("K14:N14").Select
    ActiveCell.FormulaR1C1 = "Ind Acq/Vend"
    Range("L15:M15").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-2]C[-1]:R[-2]C[2])"
    Range("L16").Select

    End Sub
dragonedellenuvole
Utente Junior
 
Post: 16
Iscritto il: 01/10/10 22:32

Re: [Excel]Query Web+Macro

Postdi Anthony47 » 05/10/10 00:03

Se la macro funziona va bene cosi', al massimo elimina tutti le righe con ActiveWindow.ScrollRow = xzym
Altri suggerimenti non ne darei, anche perche' non so che cosa devi fare nella seconda parte.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel]Query Web+Macro

Postdi dragonedellenuvole » 05/10/10 07:53

Anthony47 ha scritto:Se la macro funziona va bene cosi', al massimo elimina tutti le righe con ActiveWindow.ScrollRow = xzym
Altri suggerimenti non ne darei, anche perche' non so che cosa devi fare nella seconda parte.

Ciao



Ok thanks... Un' altra cosa, scusami se sn pressante :D Come posso dire di applicare una macro a più fogli, senza riportare il codice in ogni macro :?:
dragonedellenuvole
Utente Junior
 
Post: 16
Iscritto il: 01/10/10 22:32

Re: [Excel]Query Web+Macro

Postdi Anthony47 » 06/10/10 01:04

Immagino che per "applicare una macro a più fogli" tu intenda "applicare la query a piu' titoli, ognuno su un foglio diverso".
Se e' cosi', allora vale il suggerimento dato qui: viewtopic.php?f=26&t=88282&p=502443#p502276
Cioe' un foglio indice, che in col A contiene il codice isin e in col B il relativo foglio di calcolo.
Poi inserisci in testa alla tua macro attuale, subito dopo il titolo (Sub ASROMA(); magari dagli un nome diverso):
Codice: Seleziona tutto
For Each MyIsin in Sheets("Indice").Range("A2:A20")  '<< Nome Foglio e intervallo codici ISIN
If MyIsin.value="" then Goto Skippa
On Error Resume Next : CCC=""
CCC = Sheets(MyIsin.Offset(0,1).Value).Name
If CCC = "" Then
    Sheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = MyIsin.Offset(0,1).Value
    End If
    On Error GoTo 0
Sheets(MyIsin.offset(0,1).value).Select
'
'da qui in poi il codice della tua macro attuale, senza End Sub
'
Skippa:
Next MyIsin
End Sub

Nel codice, al posto dell' attuale "URL;http://www.borsaitaliana.it/borsa/azioni/contratti.html?isin=IT0001008876&" & Pag2 _
Userai
Codice: Seleziona tutto
"URL;http://www.borsaitaliana.it/borsa/azioni/contratti.html?isin=" & MyIsin & "&" & Pag2 _


Se i fogli mancano vengono creati, usando il nome della col B dell' elenco; eventuali fogli in piu' vengono ignorati.
Nella macro puoi inserire un intervallo per l' elenco anche piu' lungo del necessario, basta che le righe non usate abbiano la col A vuota; quindi ad esempio puoi scrivere For Each MyIsin in Sheets("Indice").Range("A2:A200") e con essa ti prepari a gestire "fino a 200" codici Isin.

Ti ricordo che questa macro genera un tot di "intervalli nominati" ad ogni esecuzione, prima o poi potrebbero darti fastidio. Se non vuoi usare la versione che scrissi qualche post fa metti almeno in testa alla macro, ancor prima dell' istruzione For Each MyIsin etc etc, queste righe che cancelleranno TUTTI gli intervalli definiti (valuta se cio' e' compatibile con la tua struttura del file):
Codice: Seleziona tutto
    For Each RName In ThisWorkbook.Names
        RName.Delete
    Next RName


Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Prossimo

Torna a Applicazioni Office Windows


Topic correlati a "[Excel]Query Web+Macro":


Chi c’è in linea

Visitano il forum: Nessuno e 100 ospiti