Condividi:        

Resume next non funziona

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: Resume next non funziona

Postdi Anthony47 » 05/10/24 16:44

Eh no, non hai seguito i consigli di Max...
Il test Is Nothing non e' sufficiente e forse non serve nemmeno; ma gli devi aggiungere il test sulla lunghezza della collezione CollA come mostrato qui:
If Not CollA Is Nothing Then
If CollA.Length > 5 Then '+++
'trovato su tlx
'gestisci i dati da tlx
On Error Resume Next
dati = Array(0, 0, 14, 1, 5, 3, 16, 17, 18, 19, 23, 24, 25, 26, 27)
For I = 2 To 14
Cells(N, I) = CollA(dati(I)).innerText
Next I
' Ws1.Range("O" & N) = "T"
On Error GoTo 0
'
'Debug.Print N, MyIsin, "Su Tlx"
End If '+++
End If '..
Ho aggiunto il livello If /End If marcato +++
Avatar utente
Anthony47
Moderatore
 
Post: 19469
Iscritto il: 21/03/06 16:03
Località: Ivrea

Sponsor
 

Re: Resume next non funziona

Postdi maxpit » 05/10/24 18:40

Confermo e ringrazio quanto indicato da Anthony47 che mi ha sollevato il morale ;) in quanto pensavo di essere riuscito a rendere chiaro il pensiero, soprattutto con l'esempio test postato:
- sia per il confronto con "is Nothing", che non serve a nulla in questo caso;
- sia per l'alternativa praticabile per individuare il mercato.

Giancarlo se il tuo scopo è ridurre i tempi, dovresti revisionare ancora il codice.

A presto
Avatar utente
maxpit
Utente Junior
 
Post: 19
Iscritto il: 04/08/24 11:59

Re: Resume next non funziona

Postdi Gianca532011 » 06/10/24 13:25

Ehmm, ho verificato in tutti i modi come da suggerimenti pervenuti, alla fine ho fatto un esperimento di alleggerimento del codice nel senso che ho rimosso parecchio e tutto sembra funzionare. Ovvio che prima ho sistemato a l'impostazione Excel della gestione degli errori, come suggerito da Anthony.
Allego codice semplificato funzionante e relativo file .

https://filetransfer.io/data-package/zo7VVGAM#link


Codice: Seleziona tutto
Option Explicit
Public Sub test2()    '
    Dim Html As Object
    Dim CollA As Object
    Dim N As Long, i As Integer
    Dim dati As Variant
    Dim dati1 As Variant
    Dim intest As Variant
    Dim MyIsin As String
    Dim uR As Long
    Dim R
    Dim Ws1 As Worksheet
    Set Ws1 = Sheets("Isin")
    Ws1.Select
    Ws1.Activate
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    '
    intest = Array("Isin", "Descrizione", "Ultimo", "Chiusura", "Variazione % ", "Valuta", "Lotto", "Cedola Periodale", "Cedola annua", "Rendimento a scadenza Lordo", "Rendimento a scadenza netto", _
                   "Rateo Lordo %", "Rateo Netto %", "Duration", "Mkt")   ' la scadenza trovasi sulla scheda Dati completi "Scadenza", Come ci arrivo ???
    Range("A1:O1") = intest
    uR = Ws1.Cells(Rows.Count, 1).End(xlUp).Row
    Ws1.Range("B2:O" & uR).Clear
    ' codifica come stringa
    Set Ws1 = Sheets("Isin")
    Ws1.Select
    Ws1.Activate
    Application.EnableEvents = False
    '
    intest = Array("Isin", "Descrizione", "Ultimo", "Chiusura", "Variazione % ", "Valuta", "Lotto", "Cedola Periodale", "Cedola annua", "Rendimento a scadenza Lordo", "Rendimento a scadenza netto", _
                   "Rateo Lordo %", "Rateo Netto %", "Duration", "Mkt")   ' la scadenza trovasi sulla scheda Dati completi "Scadenza", Come ci arrivo ???
    Range("A1:O1") = intest
    uR = Ws1.Cells(Rows.Count, 1).End(xlUp).Row
    Ws1.Range("B2:O" & uR).Clear
    ' codifica come stringa
    With Ws1
        .Range("C2:N" & uR).NumberFormat = "@"

        ' --------------converti isin a maiuscolo-------------------------------
        Dim X As Object
        For Each X In Range("A2:A" & uR)
            X.Value = UCase(X.Value)
        Next

        '----------------------------------->>>>>>>>>>>>>>>>---------------------------
        Set Html = CreateObject("htmlfile")
        With CreateObject("WINHTTP.WinHTTPRequest.5.1")

            For N = 2 To uR
                MyIsin = Cells(N, 1)
                If MyIsin <> "" Then

                    'Provo su Mot:
                    .Open "GET", "https://www.borsaitaliana.it/borsa/obbligazioni/mot/euro-obbligazioni/scheda/" & Cells(N, 1) & ".html?lang=it", False    ' Mot
                    .send
                    Html.body.innerHTML = .responseText
                    Application.Wait Now + TimeValue("00:00:01")    'pausa di 1 secondi
                   ' On Error Resume Next
                    Set CollA = Html.getElementsByClassName("t-text -right")
                   ' On Error GoTo 0

                    'If Not CollA Is Nothing Then
                    '  If CollA.Length > 5 Then    '+++
                    'trovato su Mot
                    'gestisci i dati da Mot
                    On Error Resume Next
                    dati1 = Array(0, 0, 32, 0, , , 28, 27, 40, 41, 11, 12, 13, 14, 15, 29)
                    For i = 2 To 15
                        Cells(N, i) = CollA(dati1(i)).innerText
                    Next i
                    'On Error GoTo 0

                    'Debug.Print N, MyIsin, "Su Mot"
                    ' End If
                    ' End If
                    'Prova  su TLx ?
                    '' If Cells(N, 15) <> "MOT" Then    '.condizione per attivare la ricerca tlx.

                    .Open "GET", "https://www.borsaitaliana.it/borsa/obbligazioni/eurotlx/scheda/" & Cells(N, 1) & ".html?lang=it", False    ' tlx
                    .send
                    Html.body.innerHTML = .responseText
                    Application.Wait Now + TimeValue("00:00:01")    'pausa di 1 secondi
                    'Set CollA = Nothing
                    'On Error Resume Next
                    Set CollA = Html.getElementsByClassName("t-text -right")
                   ' On Error GoTo 0
                    'If Not CollA Is Nothing Then
                    ' If CollA.Length > 5 Then    '+++
                    'trovato su tlx
                    'gestisci i dati da tlx
                   ' On Error Resume Next
                    dati = Array(0, 0, 14, 1, 5, 3, 16, 17, 18, 19, 23, 24, 25, 26, 27)

                    For i = 2 To 14
                        Cells(N, i) = CollA(dati(i)).innerText
                    Next i

                    On Error GoTo 0
                    '
                    'Debug.Print N, MyIsin, "Su Tlx"
                    ' End If    '..
                    ' End If
                    ' End If
                End If

            Next N
        End With
    End With


    ' --------------------converte testo a numero--------------------------------
    For Each R In Sheets("Isin").UsedRange.SpecialCells(xlCellTypeConstants)
        If IsNumeric(R) Then
            R.Value = CSng(R.Value)
            R.NumberFormat = "0.00"
        End If
    Next
    '
    Range("C2:D" & uR).NumberFormat = "#,##0.00"
    Range("F2:F" & uR).NumberFormat = "#,##"
    Set Html = Nothing
    Set CollA = Nothing
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub


Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 349
Iscritto il: 27/05/11 10:18

Precedente

Torna a Applicazioni Office Windows


Topic correlati a "Resume next non funziona":


Chi c’è in linea

Visitano il forum: Nessuno e 38 ospiti