Impostazioni consigliate query web

[serra]

Salve, sto utilizzando il codice elaborato da un altro post presente qua sul forum

Codice: Seleziona tutto

    Sub LISTINO()
For Each RName In ThisWorkbook.Names
        RName.Delete
Next RName
For Each MyIsin In Sheets("LISTINO").Range("A1:A76")  '<< 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

Application.ScreenUpdating = False
Application.Calculation = xlManual
Range("A1").Select

    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.borse.it/quotazioni/borsa-italiana-azioni/valore/" & MyIsin _
        , Destination:=Range("A1"))
        .Name = "MyIsin"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

Skippa:
Next MyIsin

Range("A1").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
   
End Sub

e funziona perfettamente! per ogni titolo presente in "Listino" scarica correttamente i dati da qua (andando poi nel singolo titolo che mi interessa) http://www.borse.it/quotazioni/paniere/ ... fresh_cens
Ho però il problema quando vado a collegare i dati al foglio che utilizzo per l'analisi, in quanto non in tutti i fogli sono presenti i dati sullo stesso numero di riga, e questo può cambiare anche sul medesimo foglio dopo aver aggiornato le query per scaricare i nuovi dati.
Come consigliate di agire? C'è un modo che permetta alla query aggiornandosi di non inserire nuove righe, oppure importare i dati dalla pagina dei titoli, senza i vari elenchi in modo di avere solo i dati puri e quindi teoricamente sulle stesse righe per ogni titolo?

[Anthony47]

La webquery non sa quante linee popolera' sul foglio, quindi se in una formula inserisci un collegamento a una cella specifica alla prossima estrazione quel riferimento potrebbe essere sbagliato o in Errore.

Il mi suggerimento e' che usi la funzione Confronta per identificare il titolo che ti serve dal foglio con le query; poi usi Indice(Intervallo(ValoreDelConfronta) per riprendere i dati del titolo
Esempio
In cella A2 di Foglio2

Codice: Seleziona tutto

=Confronta("TIT";Foglio1!A:A;0)

In cella B2 di Foglio2

Codice: Seleziona tutto

=Indice(Foglio1!B:B;A2)


Questa ti estrarra' da Foglio1 il valore di colonna B della riga che in colonna A contiene il valore TIT

Vedi se riesci ad applicare ai tuoi dati...

[serra]

Ho intrapreso un'altra strada che mi è più funzionale, ma mi sto perdendo probabilmente in un bicchiere d'acqua
Praticamente con la funziona cerca trovo l'intestazione del dato che mi interessa, poi posizionandomi nella riga sotto seleziono il dato, ma non riesco a fare in modo che venga inserito con un riferimento fisso nella riga F (per esempio) posto il codice completo

Codice: Seleziona tutto

Sub Aggiornaazioni()
    Dim i As Integer
    Fine = Sheets.Count
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
   
        Sheets("Gestione").Range("A1").Select
       For i = 11 To Fine
          With Sheets(i)
           .Activate
Range("A1").QueryTable.Refresh BackgroundQuery:=False
Cells.Find(What:="Ultimo Prezzo", After:=Range("A1"), LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 0).Select
Range("F1").Select
ActiveCell.FormulaR1C1 = "=" <<< Non so come compilare qua per inserire il riferimento fisso alla cella cercata prima

Cells.Find(What:="Numero azioni", After:=Range("A1"), LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 0).Select  <<< Questa è una eventuale soluzione trovata, nel caso poi inserirò nel foglio di analisi il riferimento fisso alle celle F1 e F2
Selection.Copy
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
          End With

       Next
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
   
    Sheets("GESTIONE").Select
    Range("E2") = Date
    Range("A1").Select
End Sub

[Anthony47]

Ho capito che vuoi crearti uno specchietto riepilogativo, da usare poi per le elaborazioni successive.
Allora creati su un foglio che chiamerai ad esempio MioRIEP uno specchietto contenente in verticale su colonna A le informazioni da pescare (come sono chiamate sui fogli di query) e in orizzontale su riga 1 i fogli dove le informazioni sono memorizzate. Come ho fatto ad esempio io (celle in grigio)


Poi in un Modulo standard del vba inserisci questa macro:

Codice: Seleziona tutto

Sub CreaRiep()
Dim myR As Worksheet, myI As Long, myT As Long
Dim myMatch
'
Set myR = Sheets("MioRIEP")
    For myT = 2 To myR.Cells(1, Columns.Count).End(xlToLeft).Column
        For myI = 2 To myR.Cells(Rows.Count, 1).End(xlUp).Row
        On Error Resume Next
            myMatch = CVErr(2042)
            myMatch = Application.Match(myR.Cells(myI, 1).Value, Sheets(myR.Cells(1, myT).Value).Range("A1:A1000"), 0)
            On Error GoTo 0
            If IsError(myMatch) Then
                myR.Cells(myI, myT).ClearContents
            Else
                myR.Cells(myI, myT) = Sheets(myR.Cells(1, myT).Value).Cells(myMatch + 1, 1)
            End If
        Next myI
    Next myT
End Sub

Puoi in coda alla macro che fa le webquery inserisci

Codice: Seleziona tutto

Application.ScreenUpdating = True
Call CreaRiep     '<<< INSERISCI QUESTA   
End Sub

Questo ti creera' uno specchietto complessivo con le informazioni richieste.

Puoi eseguire la Sub CreaRiep anche a mano o con altre automazioni.

Cosi' per curiosita', lo stesso specchietto lo puoi ricreare con formule, come si vede in B12 e celle adiacenti.
La formula in B12:

Codice: Seleziona tutto

=INDICE(INDIRETTO(B$1&"!A1:A1000");1+CONFRONTA($A2;INDIRETTO(B$1&"!A1:A1000");0))

Poi la copi "a destra e in basso, per quante righe /colonne hai nello specchietto

Infine ti consiglio di modificare le impostazioni di RefreshStyle: non xlInsertDeleteCells ma

Codice: Seleziona tutto

.RefreshStyle = xlOverwriteCells

Ciao

[serra]

Ti ringrazio davvero molto!! così finalmente sono riuscito a implementare il tutto!
Avrei una ulteriore domanda: per aggiornare la query foglio per foglio uso questo codice ma è molto lento e spesso si blocca facendo crashare excel, qualche consiglio su come fare?

Codice: Seleziona tutto

Sub Aggiornaazioni()
    Dim i As Integer
    Fine = Sheets.Count
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
   
        Sheets("Gestione").Range("A1").Select
       For i = 11 To Fine
          With Sheets(i)
           .Activate
Range("A1").QueryTable.Refresh BackgroundQuery:=False
          End With

       Next
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
   
Call creariep

    Sheets("GESTIONE").Select
    Range("E2") = Date
    Range("A1").Select
End Sub

[Anthony47]

Purtroppo se hai 11 query l'aggiornamento ti richiedera' 20-30 secondi; e se una query non viene risposta dal server bisogna aspettare un timeout che sembra infinito.

Una alternativa sofisticata puo' essere passare a ". Refresh BackgroundQuery:=True" e poi gestire gli eventi AfterRefresh per determinare in modo asincrono quando tutte le query sono terminate e solo a quel momento eseguire la Sub creariep. Ma usa moduli di classe, e l'uso delle stesse procedure per tante query non e' di facile spiegazione. Quindi non ti mando su quella strada.

Una possibile alternativa potrebbe essere quella di creare lo specchietto riassuntivo con le formule e poi, nella tua Sub Aggiornaazioni usi

Codice: Seleziona tutto

Range("A1").QueryTable.Refresh BackgroundQuery:=True    '<<< Invece che False

oltre che eliminare il richiamo alla creariep che non dovrebbe piu' essere usata (altrimenti distrugge le formule).
In questo modo le formule aggiorneranno lo specchietto riassuntivo man mano che le query si completano (potrebbero esserci dei valori vuoti o di errore durante il transitorio).

Anzi, molto piu' semplice, abbandoni la Sub Aggiornaazioni e imposti (nelle proprieta' delle singole query) l'opzione "Aggiorna ogni N minuti", cosi' i valori dovrebbero aggiornarsi periodicamente e di conseguenza lo specchietto (se calcolato con le formule).

Puoi impostare questa proprieta' se modifichi, all'interno della Sub LISTINO, le righe

Codice: Seleziona tutto

.RefreshPeriod = 10    '<<< es 10 minuti; invece che 0=mai

Codice: Seleziona tutto

.Refresh BackgroundQuery:=True    '<<< Invece che False

Poi riesegui la Sub LISTINO e dovrebbe essere tutto fatto.

Ciao

[serra]

Il fatto che parte dal foglio 11 e arriva fino al foglio 90 e passa, quindi mettevo già in preventivo 10 minuti per aggiornarle tutte.
Con la macro che ho messo prima, seppure elegante e bella si bloccava, per ora ho risolto senza complicarmi troppo la vita

Codice: Seleziona tutto

Worksheet(XXX).Range("A1").QueryTable.Refresh BackgroundQuery:=False

Così per ogni foglio, ovviamente non la soluzione migliore, ma funziona quindi va bene così per ora.
Per quanto riguarda invece gli aggiorna vari (temporizzato o background) non mi è funzionale perchè apro il foglio la sera, aggiorno i dati, vedo se trova un qualche segnale utile per il mercato, e chiudo fino alla sera dopo.