Ho questa macro che scarica gli indici di borsa , funziona quasi bene eccetto il fatto che in colonna B mi produce una stringa della quale mi serve solo una parte che può essere quella iniziale o quella finale (identiche) . Ma non so come ottenere tale risultato in VBA . Ho trovato una macro annulla spazi ma non è adeguata al problema . Suggerimenti ?
https://postimg.cc/F1fsHWpj]
- Codice: Seleziona tutto
Sub Importa_Dati_Web()
Dim HTML_Content As Object
Dim Tr As Object, Td As Object, iTab As Object
Dim Nome, iRow As Long, iCol As Integer
Application.ScreenUpdating = False
Cells.Clear
Const Web_URL = "https://www.borsaitaliana.it/borsa/azioni/tutti-gli-indici.html"
Set HTML_Content = CreateObject("htmlfile")
With CreateObject("msxml2.xmlhttp")
.Open "GET", Web_URL, False
.send
HTML_Content.body.innerHTML = .responseText
End With
iRow = 1: iCol = 2
For Each iTab In HTML_Content.getElementsByTagName("table")
For Each Tr In iTab.Rows
For Each Td In Tr.Cells
If iCol = 1 And iRow > 1 Then
Nome = Split(Td.innerText) '.Chr(13)
Cells(iRow, iCol) = Nome(LBound(Nome))
iCol = iCol + 1
Else
Cells(iRow, iCol) = Td.innerText
iCol = iCol + 1
End If
Next Td
iCol = 2
iRow = iRow + 1
Next Tr
iCol = 2
iRow = iRow + 1
Next iTab
Dim sh As Worksheet
Set sh = Sheets("Foglio1")
'uR = Cells(Rows.Count, 1).End(xlUp).Row
' Range("A2:A" & uR).SpecialCells(xlCellTypeBlanks).Offset(1, 0).EntireRow.Delete
'Range("A2:A" & uR).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
MsgBox "Dati scaricati", vbInformation, "NOTIFICA"
End Sub
Sub annulla_spazi()
Dim wks As Worksheet 'dichiaro le variabili
Dim y As Long
Set wks = Worksheets("Foglio1") 'imposto come wks il Foglio1
Application.ScreenUpdating = False 'evito lo sfarfallio nell’esecuzione della macro
For y = 1 To 100
With wks.Range("A" & y) 'spazzolo la colonna A per ogni valore (da A1 a A100)
.Value = Trim(.Value) 'tolgo tutti gli spazi iniziali e finali]
Do While InStr(1, .Value, " ") > 0 'cerco per ogni stringa quando c’è più di uno spazio indipendentemente dal numero
.Value = Replace(.Value, " ", " ") 'sostituisco tutti gli spazi trovati con un solo spazio
Loop
.Value = .Value & " " 'aggiungo uno spazio alla fine della stringa
End With
Next
Set wks = Nothing
Application.ScreenUpdating = True 'ripristino l'istruzione sopra inibita
End Sub