Moderatori: Anthony47, Flash30005
Sub GetTabContr()
Dim BetFlag As Boolean, myURL0 As String, myURL1 As String, myColl, myItm
Dim myInner As String, myPages
myURL0 = "http://www.borsaitaliana.it/borsa/azioni/aim-italia/contratti.html?isin="
myURL1 = "&lang=it&page="
Set ie = CreateObject("InternetExplorer.Application")
I = 1
'Leggi le tabelle, sul foglio PRELIEVO
Worksheets("PRELIEVO").Select
Range("A2").Resize(20000, 10).ClearContents
For Page = 0 To 1000
With ie
.navigate myURL0 & Range("L1").Value & myURL1 & Page
.Visible = True
Do While .Busy: DoEvents: Loop 'Attesa not busy
Do While .readyState <> 4: DoEvents: Loop 'Attesa documento
End With
'
myStart = Timer 'attesa addizionale
Do
DoEvents
If Timer > myStart + 0.3 Or Timer < myStart Then Exit Do
Loop
Set myColl = ie.document.getElementsByTagName("p")
For Each myItm In myColl
If myItm.classname = "floatsx" Then
myInner = Trim(Replace(myItm.innertext, "Pag. ", "", , , vbTextCompare))
myPages = Split(myInner, "/", , vbTextCompare)
Exit For
End If
Next myItm
' I = 5
Set myColl = ie.document.getElementsByTagName("TABLE")
aaa = myColl.Length
Set myItm = myColl(aaa - 1)
If myItm.classname = "table_dati" Then
For Each trtr In myItm.Rows
For Each tdtd In trtr.Cells
DoEvents
aaaa = tdtd.classname
If tdtd.classname <> "name" And tdtd.classname <> "aligndx" Then
If J = 1 Or J = 2 Or J = 3 Then
Cells(I + 1, J + 1) = CDbl(Trim(tdtd.innertext))
Else
Cells(I + 1, J + 1) = Trim(tdtd.innertext)
End If
J = J + 1
End If
Next tdtd
I = I + 1: J = 0
Next trtr
I = I + 1: J = 0
End If
' Next myItm
If Page = (CLng(myPages(UBound(myPages, 1))) - 1) Then Exit For
Next Page
'
MsgBox("Completato...")
Stop 'Vedi testo
'
'Chiusura IE
ie.Quit
Set ie = Nothing
End Sub
Sub getTables()
Dim Dest As String, myRoot As String, I As Long, myRan As Range
Dest = "Foglio3" '<< Il foglio dove sara' creato l' elenco
aaa = Selection.CurrentRegion.Address
myRoot = "URL;http://www.borsaitaliana.it/borsa/azioni/contratti.html?isin=IT0003506190&lang=it&page="
With Range("A1").QueryTable
For I = 0 To 1000
.Connection = myRoot & I
.Refresh BackgroundQuery:=False
Set myRan = Range(Range("A2"), Range("E2").End(xlDown))
myRan.Copy Destination:=Sheets(Dest).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
If myRan.Rows.Count < 20 Then Exit For
DoEvents
Next I
End With
'
End Sub
Anthony47 ha scritto:Ho notato che quando si richiede una pagina superiore al max disponibile viene riproposta la pag. 0; potresti quindi esaminare le cifre delle Ore e, se inferiore all' ultima posizionata su foglio Dest ritenere completato l'aggiornamento.
Mi sembra la soluzione piu' semplice.
Ciao
Columns("A:A").Select
Selection.Replace What:=".", Replacement:=":", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Anthony47 ha scritto:Se dal sito importi in colonna A 17.34.31 e il tuo sepratore orario e' ":" allora prova a mettere subito prima di End Sub queste istruzioni:
- Codice: Seleziona tutto
Columns("A:A").Select
Selection.Replace What:=".", Replacement:=":", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Ciao
Torna a Applicazioni Office Windows
Inserire add.in nella barra di avvio veloce in excel 2003 Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 4 |
Excel: problema con date se devo unirle a testi Autore: valle1975 |
Forum: Applicazioni Office Windows Risposte: 5 |
confrontare e evidenziare 2 fogli excel Autore: niccia |
Forum: Applicazioni Office Windows Risposte: 7 |
[EXCEL] controllo corrispondenza tra valori con un vincolo Autore: sbs |
Forum: Applicazioni Office Windows Risposte: 9 |
Visitano il forum: Nessuno e 14 ospiti