Moderatori: Anthony47, Flash30005
'Leggi la tabella
'Worksheets.Add
Cells.Clear
Set myColl = IE.document.getElementsByTagName("TABLE")
For Each Tbl In myColl
Tabnum = Tabnum + 1
RowNum = RowNum + 1
Set CRng = Range("B" & RowNum)
CRng.Offset(0, -1) = "Tab # " & Tabnum
For Each TRw In Tbl.Rows
For Each TCel In TRw.Cells
CRng.Value = TCel.innerText 'outerText
Set CRng = CRng.Offset(0, 1)
I = I + 1
Next TCel
RowNum = RowNum + 1
Set CRng = CRng.Offset(1, -I)
I = 0
Next TRw
Exit For
Next Tbl
Stop 'Vedi testo
myURL = http://txodds.com/omoves.php/
Sub DATI_DA_WEB()
Application.ScreenUpdating = False
Sheets("dati").Select
Range("A2:R1000").Select
Selection.ClearContents
Dim objMSHTML As New MSHTML.HTMLDocument
Dim objDoc As MSHTML.HTMLDocument
Dim oTab As MSHTML.HTMLTable
Dim oTabRow As MSHTML.HTMLTableRow
Dim oTabEl As MSHTML.IHTMLElement
With Foglio2.QueryTables("omoves.php?ot=0")
.Refresh BackgroundQuery:=False
End With
Set objDoc = objMSHTML.createDocumentFromUrl("http://txodds.com/omoves.php?ot=0", vbNullString) ' ORIGINALE
Do While objDoc.readyState <> "complete"
DoEvents
Loop
Set oTab = objDoc.all.tags("table").Item(0)
Dim j As Integer
Dim h As String
Dim i As Integer
For i = 1 To oTab.Rows.Length - 1 'selezione delle righe della tabella
For j = 0 To 18 'selezione delle colonne
Set oTabRow = oTab.Rows.Item(i)
Set oTabEl = oTabRow.Cells.Item(j)
h = oTabEl.innerText
Cells(i, j + 1) = h
Next j
Next i
For i = 1 To 50
If Range("A" & i) = "date" Then
inizio_copia = i + 1
Exit For
End If
Next i
For i = inizio_copia To 600
If Range("A" & i) = "" Then
fine_copia = i - 1
Exit For
End If
Next i
Range("S2:S600").Select
Selection.ClearContents
Range("S1").Select
Selection.Copy
Range("S" & inizio_copia & ":S" & fine_copia).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A" & inizio_copia & ":S" & fine_copia).Select
ActiveWorkbook.Worksheets("DATI").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("DATI").Sort.SortFields.Add Key:=Range("A" & inizio_copia & ":A" & fine_copia _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("DATI").Sort.SortFields.Add Key:=Range("R" & inizio_copia & ":R" & fine_copia _
), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("DATI").Sort
.SetRange Range("A" & inizio_copia & ":S" & fine_copia)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Anthony47 ha scritto:Dopo che hai importato tutti i dati fai uno scan dall' ultima alla prima riga (ciclo forza /Next) e se la data e' diversa da int(now()) allora cancella la riga intera. Se non riesci più tardi ti potrò dare un ciclo funzionante.
Ciao
If Left(Range("B" & RR).Value, 5) <> Format(Range("AB1").Value, "dd/mm") Then
For i = 1 To oTab.Rows.Length - 1 'selezione delle righe della tabella
For j = 0 To 18 'selezione delle colonne
Set oTabRow = oTab.Rows.Item(i)
Set oTabEl = oTabRow.Cells.Item(j)
h = oTabEl.innerText
If Col1 Then Cells(i, j + 1) = CDate(h) Else Cells(i, j + 1) = h '>>>
Col1 = False '>>>
Next j
Col1 = True '>>>
Next i
Range("A:Z").ClearContents
For i = 1 To oTab.Rows.Length - 1 'selezione delle righe della tabella
For j = 0 To 18 'selezione delle colonne
Set oTabRow = oTab.Rows.Item(i)
Set oTabEl = oTabRow.Cells.Item(j)
h = oTabEl.innerText
If Col1 Then
Cells(i - kk, j + 1) = CDate(h)
If (Int(Cells(i - kk, j + 1)) <> Int(Range("Ab1"))) And Range("AB1") <> "" Then _
Cells(i - kk, j + 1).Clear: kk = kk + 1: Exit For
Else
Cells(i - kk, j + 1) = h
End If
Col1 = False
Next j
Col1 = True
Next i
LastRA = Cells(Rows.count,"A").End(xlup).Row +1
LastRF = Cells(Rows.count,"F").End(xlup).Row
Worksheets("Foglio2").Range("A1:F" & LastF).Copy
Sub Smile()
Sheets("Totali").Cells.Clear
End Sub
Torna a Applicazioni Office Windows
Excel: formula automatica per evidenziare prodotto scaduto Autore: gamma_ray |
Forum: Applicazioni Office Windows Risposte: 3 |
Salvare file excel in formato html escludendo le immagini Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 10 |
formula excel non visualizza risultato Autore: tommasog |
Forum: Applicazioni Office Windows Risposte: 6 |
Excel 2016 - Funzione SCARTO + INDIRETTO Autore: pl1957 |
Forum: Applicazioni Office Windows Risposte: 2 |
Visitano il forum: Nessuno e 102 ospiti