Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Ottimizzare/velocizzare 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

Ottimizzare/velocizzare macro

Postdi niubbophys » 01/07/15 09:01

Un saluto a tutti!

Ho la seguente macro https://www.dropbox.com/s/5myntzrtixuwr ... q.xls?dl=0
Vorrei gentilmente alcuni consigli se c'è la possibilità di migliorarla al fine di una migliore esecuzione, sia in rapidità che pulizia di codice (mi sono accorto che alcune volte IE non si chiude come dovrebbe...)
Tenete presente che la macro è il risultato di tante "sotto macro" fuse insieme da me, prendendo le varie parti "qua e là" per i forum... Insomma da non esperto in materia mi sono arrangiato.
La macro per funzionare funziona, cerco solo l'aiuto di qualcuno che la possa rendere più fluida possibile.

Ringrazio anticipatamente.

Ps: ne ho anche una versione "temporizzata" sulla quale ho qualche problemino con application.wait Ma ve la sottopongo in un secondo momento.
niubbophys
Newbie
 
Post: 9
Iscritto il: 31/05/15 11:35

Sponsor
 

Re: Ottimizzare/velocizzare macro

Postdi ricky53 » 01/07/15 13:37

Ciao,
il file non sarà disponibile per tanto tempo, quindi, è preferibile che tu riporti il codice direttamente nel forum.
Sarà utile in futuro ad altri utenti.
Grazie.
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. W7; Office 2003-10-13-16
Avatar utente
ricky53
Utente Senior
 
Post: 4223
Iscritto il: 11/04/09 19:29
Località: Italia

Re: Ottimizzare/velocizzare macro

Postdi niubbophys » 01/07/15 14:18

ricky53 ha scritto:Ciao,
il file non sarà disponibile per tanto tempo, quindi, è preferibile che tu riporti il codice direttamente nel forum.
Sarà utile in futuro ad altri utenti.
Grazie.


Ciao!

Scusa non ci avevo pensato a mettere il codice. Provvedo subito. Grazie e tanti saluti.
Codice: Seleziona tutto
Option Explicit
Const MAXISIN As Integer = 100
Private Sub cmdClear_Click()
   Dim s As Worksheet
   'elimina tutti i fogli eccetto 'Foglio1'
   Application.DisplayAlerts = False
   Application.ScreenUpdating = False
   For Each s In Worksheets
      If s.Name <> "Foglio1" Then
         s.Select
         ActiveWindow.SelectedSheets.Delete
      End If
   Next
   Application.DisplayAlerts = True
   Range("C2:AE999").ClearContents
   Range("AG1:AG999").ClearContents
   Range("AK16:AM65").ClearContents
   Application.ScreenUpdating = True
End Sub
Private Sub cmdScarica_Click()
   Dim s As Worksheet, i As Integer, r As Integer, ISIN As String, prec As String, URL As String, myRan As Range, c As Integer
   Dim t As Integer, ult As Integer, titolo As String, N As Long, NT As Long, p As Integer, FASCIA As Integer
   Dim ie As Object, z As Integer
   Dim Doc As HTMLDocument
   Dim Stats As Object, Stat As Object
   Dim kfirst As Range, k As Range, X As String, LR As Long, response As VbMsgBoxResult
   Dim y As String
   Dim indexOfThey As Integer
   Dim finalString As String
   Dim singola As Integer
   
   cmdClear_Click
   prec = "Foglio1"
   '-------------------------- crea i nuovi fogli
   For r = 2 To MAXISIN
      ISIN = UCase$(Trim$(Cells(r, 1)))   'prende l'ISIN da colonna A
      If ISIN = "" Then Exit Sub   'se vuoto: fine ISIN, fatto !
      titolo = Trim$(Cells(r, 2))
      If titolo = "" Then titolo = ISIN
      '--------per ogni ISIN in colonna A crea un foglio specifico
      Sheets.Add
      ActiveSheet.[A1] = "Ora"
      ActiveSheet.[B1] = "Prezzo"
      ActiveSheet.[C1] = "Volume"
      '...e lo sposta in fondo
      ActiveSheet.Name = titolo
      Sheets(titolo).Move After:=Sheets(prec)
      prec = titolo
     
      '-----cerca il valore dell'ultima pagina (prima parte, cerca tutti gli a href)
       
        For p = 13 To 1 Step -1
            Set ie = New InternetExplorer
            ie.Visible = False
            FASCIA = p
            ie.navigate "http://www.nasdaq.com/symbol/" & ISIN & "/time-sales?time=" & FASCIA '& "&pageno=1"
            Do
            DoEvents
            Loop Until ie.readyState = READYSTATE_COMPLETE
            Set Doc = ie.document
            Set Stats = Doc.getElementsByTagName("a")
            z = 0
                For Each Stat In Stats
                    Range("AG1").Offset(z, 0).Value = Stat.href
                    z = z + 1
                Next
            ie.Quit
            'Set ie = Nothing

'-----cerca il valore ultima pagina (seconda parte, negli a href scegli quelli con la pagina, prende l'ultimo e poi estrae il numero pagina)
            X = "pageno"
            Sheets("Foglio1").Activate
                Set kfirst = Columns(33).Find(What:=X, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                    If kfirst Is Nothing Then
                        'MsgBox ("Not found")
                         With Sheets("Foglio1")
                            LR = .Range("E" & Rows.Count).End(xlUp).Row
                            .Range("E" & LR + r - 1).Offset(0, 2 * p).Value = "pageno=1"
                        End With
                    Else
                        With Sheets("Foglio1")
                            LR = .Range("E" & Rows.Count).End(xlUp).Row
                            .Range("E" & LR + r - 1).Offset(0, 2 * p).Value = kfirst.Value
                        End With
                        Set k = Columns(33).FindNext(After:=kfirst)
                        While (Not kfirst.Address = k.Address)
                            With Sheets("Foglio1")
                                LR = .Range("E" & Rows.Count).End(xlUp).Row
                                .Range("E" & LR + r - 1).Offset(0, 2 * p).Value = k.Value
                            End With
                            Set k = Columns(33).FindNext(After:=k)
                        Wend
                    End If
               
        Sheets("Foglio1").Activate
        y = Cells(r, 5 + 2 * p)
        indexOfThey = InStr(1, y, "=")
        finalString = Right(y, Len(y) - indexOfThey + 0)
        Cells(r, 5 + 2 * p).Value = finalString
        y = Cells(r, 5 + 2 * p)
        indexOfThey = InStr(1, y, "=")
        finalString = Right(y, Len(y) - indexOfThey + 0)
        Cells(r, 5 + 2 * p).Value = finalString


           
      '-------------crea l'URL per la query
      URL = "URL;http://www.nasdaq.com/symbol/" & ISIN & "/time-sales?time=" & FASCIA & "&pageno="
      Sheets("Foglio1").Activate
      Range("AK16:AM65").ClearContents    'pulisce l'area dati
      Range("AK16:AM65").Select
      N = 0
      Cells(r, 4 + 2 * p) = N
      With Selection.QueryTable
        For i = 1 To Cells(r, 5 + 2 * p)
        .Connection = URL & CStr(i)
        .Refresh BackgroundQuery:=False
        ult = 15
            For t = 16 To 66
                If Cells(t, 37) = "" Then Exit For
                ult = t
            Next
        N = N + ult - 15
        Cells(r, 4 + 2 * p) = N 'contratti per fascia oraria
        Set myRan = Range(Range("AK16"), Range("AM" & CStr(t))) '.End(xlDown))
        myRan.Copy Destination:=Sheets(titolo).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        If ult < 65 Then Exit For
        DoEvents
        Next
      End With
      Range("AG1:AG999").ClearContents
    Next
    Cells(r, 3) = 0
    For p = 1 To 13
        Cells(r, 3) = Cells(r, 3) + Cells(r, 4 + 2 * p) 'contratti totali per ISIN
    Next
nextISIN:
   Next
   Sheets("Foglio1").Activate
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Dim r As Integer, w As Integer, ISIN As String, FASCIA As Integer
   Cancel = True
   r = Target.Row
   w = Target.Column
   If (w = 1 Or w = 2) And r > 1 Then
      ISIN = Trim$(UCase$(Cells(r, 1).Text))
      If ISIN <> "" Then
         ThisWorkbook.FollowHyperlink "http://www.nasdaq.com/symbol/" & ISIN & "/time-sales?time=" & FASCIA & "&pageno=1"
      End If
   End If
End Sub
niubbophys
Newbie
 
Post: 9
Iscritto il: 31/05/15 11:35


Torna a Applicazioni Office Windows


Topic correlati a "Ottimizzare/velocizzare macro":

Ottimizzare sito WORDPRESS
Autore: nikita75
Forum: Discussioni
Risposte: 0

Chi c’è in linea

Visitano il forum: enrico43 e 12 ospiti