scrivo poche righe per cercare qualcuno che mi venga incontro e mi aiuti a risolvere alcuni problemi:
I problemi sono:
1) come si può notare nel foglio " Data " in L10 ed M10
i risultati di calcio mi compaiono con i giorni e i mesi... in formato data... come posso formattarli automaticamente tale da avere i numeri dei goal ?
2) come evitare la formattazione RTF
con " InternetExplorer.Application " ?
Nota Bene: se formatto le righe delle colonne L ed M in formato testo alcune mi compaiono come risultati ? - ? altre mi compaiono sotto forma di 5 cifre ( ossia data )
- Allego la cartella di lavoro " Now... To Set"
NowGoal ToSet.xlsm
1) In questa cartella di lavoro c'è una macro "ImpWebTbl" scritta con " InternetExplorer.Application " :
- Codice: Seleziona tutto
Sub ImpWebTbl()
Dim mIE As Object
Dim mTables, mTable
Dim mRows, mRow
Dim mCells, mCell
Dim mRiga As Long, mColonna As Long
Dim k1 As Integer, n As Integer
On Error GoTo Errori
Worksheets("Data").Select
'controlli
n = 1 ' tbl da importare se presente
mRiga = 8 'inizio scrittura tabella
k1 = 0
Set mIE = CreateObject("InternetExplorer.Application")
With mIE
.AddressBar = False
.StatusBar = False
.MenuBar = False
.Toolbar = 0
.Visible = False
.navigate "http://data.nowgoal.com/1x2/bet007history.htm?id=&company=&matchdate=" & [AA2] & "-" & [AA3] & "-" & [AA4]
End With
While mIE.Busy
Wend
While mIE.document.readyState <> "complete"
Wend
Set mTables = mIE.document.all.tags("TABLE")
With mTables
For Each mTable In mTables
k1 = k1 1
With Range(Cells(mRiga - 2, 1), Cells(mRiga - 2, 1))
.Value = "Table: " & k1
.Interior.ColorIndex = 37
.Font.Bold = True
End With
If Range("D3") <> "" Then k1 = n
Set mRows = mTable.Rows
For Each mRow In mRows
Set mCells = mRow.Cells
nCol = mCells.Length
If PreNCol > nCol Then
mColonna = PreNCol - nCol - 1
Else
mColonna = 1
End If
For Each mCell In mCells
ActiveSheet.Cells(mRiga, mColonna) = mCell.innerText
mColonna = mColonna 1
Next mCell
PreNCol = nCol
mRiga = mRiga 1
Next mRow
If n <> 0 And k1 = n Then GoTo Uscita
mRiga = mRiga 3
Next mTable
End With
Uscita:
Set mCell = Nothing
Set mCells = Nothing
Set mRow = Nothing
Set mRows = Nothing
Set mTable = Nothing
Set mTables = Nothing
mIE.Quit
Set mIE = Nothing
Sheets("Data").Select
Range("L6").Select
Selection.Copy
Sheets("ToBet").Select
Range("Av1:av177").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Data").Select
Range("L6").Select
Selection.Copy
Sheets("ToBet").Select
Range("b1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("ToBet").Select
Range("b2").Select
Exit Sub
Errori:
MsgBox Err.Number & "-" & Err.Description
Resume Uscita
Columns("B:B").Select
Selection.ColumnWidth = 10.67
Selection.ColumnWidth = 12.67
Selection.ColumnWidth = 16
Columns("K:K").Select
Selection.ColumnWidth = 17.44
Selection.ColumnWidth = 21.56
Range("A6").Select
End Sub
Come si noterà nel file allegato nel foglio "Data"... in AA1 ho la cella di controllo con la data corrispondente a quella dell url da cui scarico i dati:
http://data.nowgoal.com/1x2/bet007history.htm?id=&company=&matchdate=2004-12-01
Spero vivamente che qualcuno mi aiuti di Cuore!!!
Ringrazio in anticipo chi verrà incontro al mio rompicapo...
A presto,
Frank.
