Estrazione dati da HTML

[replymonster]

Buongiorno a tutti,

Mi rivoglo di nuovo al vostro forum per un problema di tipo pratico nell'importare dati da un sito HTML.
Parliamo di questa pagina riguardo un prontuario di Farmaci che devo estrarre ed inserire in un foglio di calcolo Excel https://www.torrinomedica.it/farmaci/prontuario/Prontuario_Aa-Ac.asp.

Il problema è che nel momento in cui copio->incollo i dati nel foglio Excel effettivamente me li copia in modo corretto però tutti dentro una sola cella. Adesso mi servirebbero ovviamente separati in modo intelligente rispettando sempre lo stesso format, il che penso renda possibile quindi la possibilità di una formula per delimitarli in modo ierativo.

Nello specifico ogni farmaco ha due righe informative:
1. Nome del farmaco, Composizione, Principio Attivo (scritto tra parentesi)
2. Classe, NotaAIFA, Ricetta, Tipo, Info, ATC, AIC, Prezzo, Ditta

Il tutto si può intuire guardando la pagina web.
La domanda è quindi se esiste la possibilità di creare una tabella in modo automatico oppure devo procedere a mano (oltre 80mila righe) per separle. Anche un processo semi automatico sarebbe comunque gradito.

Grazie ancora per il vostro tempo.

[Zer0Kelvin]

Ciao.
Fare si può fare tutto, ma occorre specificare meglio il risultato desiderato.
Allega un file Excel con un pò di righe importate e a fianco (o su altro foglio) il risultato desiderato scritto manualmente.
Specifica bene i campi che devi intabellare.

[Anthony47]

A me pare che in excel le informazioni vengano scritte esattamente come sono sulla pagina web, cioe' un sfilza di informazioni che si susseguono liberamente.

Per un'acquisizione piu' utile bisogna leggere il sorgente htm ed elaborarlo; partendo da una delle tante automazioni analoghe ho configurato questa macro:

Codice: Seleziona tutto

Sub GetTabbb()
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=109381
myURL = "https://www.torrinomedica.it/farmaci/prontuario/Prontuario_Aa-Ac.asp"
Set ie = CreateObject("InternetExplorer.Application")
   
With ie
    .navigate myURL
    .Visible = True
'Stop                '*** VEDI Testo
    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 + 2 Or Timer < myStart Then Exit Do
Loop

Dim myColl, myCollA, myCollS, myItm, myS

'Leggi le tabelle SUL FOGLIO ATTIVO
''Sheets("Classifica Home").Select
Cells.Clear
Set myColl = ie.document.getElementById("listaprontuario")
Set myCollA = ie.document.getElementsByTagName("a")
For Each myItm In myCollA
'Debug.Print myItm.className
    If InStr(1, myItm.className, "riga", vbTextCompare) > 0 Then
        I = I + 1: j = 0
        Set myCollS = myItm.getElementsByTagName("span")
        For Each myS In myCollS
            j = j + 1
            If I = I Then Cells(1, j) = myS.className
            Cells(I + 1, j) = myS.innerText
        Next myS
    I = I + 1
    End If

Next myItm
'Stop
'
'Chiusura IE
ie.Quit
Set ie = Nothing
End Sub


Va messa in un "modulo standard del vba"; per questo, partendo da Excel:
-premi Alt-F11 per aprire l'editor delle macro
-Menu /Inserisci /Modulo
-Copia il codice e incollalo nel frame dx del modulo appena creato

Poi torna su Excel, posizionati sul foglio VUOTO in cui vuoi importare l'elenco e lancia la macro GetTabbb:
-premi Alt-F8
-seleziona GetTabbb dall'elenco di macro disponibili
-premi Esegui

La macro aprira' una sessione InternetExplorer dedicata, apre la pagina, legge le informazioni e le posiziona sul foglio Excel; infine chiude la sessione I.E. In questa fase e' meglio non interagire sul pc.

Ciao

[replymonster]

Grazie per la risposta veloce,

Come giustamente richiesto allego il file Excel contenente del risultato desiderato.
Nello specifico ho strutturato due tabelle:
- La prima, nella parte superiore, che equivale a quella presente sul sito riportata su Excel
- La seconda, invece, è manipolata in modo tale che i dati siano già messi in modo da poter essere elaborati per studi futuri

Chiaramente preferirei la seconda struttura ma non ho la capacità di capire se sia possibile farlo già direttamente nella fase di import oppure successivamente modellando la prima tabella. Detto ciò l'esempio riportato si riferisce ad i primi due Farmaci della lista più uno intermedio per far ben comprendere la struttura della tabella.

http://www.filedropper.com/prontuariotorrino
(Non riesco ad ellgarlo per cui ho fatto l'upload su un sito di hosting, non so se sia corretto)

Grazie.

RISOLTO!

[replymonster]

Grazie per le risposte estremamente veloci,

Nello specifico Anthony come in precedenza sei una garanzia, funziona una meraviglia, veramente grazie tante.

Vi auguro una buona giornata e buon fine settimana,

PS. Come si allegano i file su questo Forum ??

[Anthony47]

Per allegare un file hai fatto bene ad usare una piattaforma di file hosting.

Per le nostre istruzioni: viewtopic.php?f=26&t=103893&p=605487#p605487

Ciao

[Zer0Kelvin]

Ciao.
Non ho capito se il problema è risolto o meno; io ho provato la macro di Anthony ma non mi ha caricato nulla.
Comunque, nel frattempo avevo messo a punto una macro per convertire in tabella i dati copiati dal sito.
E' alquanto maccheronica, ma funziona

Codice: Seleziona tutto

Public Sub CreaTabellaFarmaci()
Dim R1 As Long, R2 As Long, U As Long, L As Long, Ri As Long
Dim sOrig As Worksheet, sDest As Worksheet
Dim Sp As Variant, Riga As Variant
Dim Token As String
    Set sOrig = Sheets("Prontuario")
    Set sDest = Sheets("Tabella")
    R1 = 1 'prima riga dati
    R2 = 2 'prima riga tabella destinazione
    With sOrig
        Do While .Cells(R1, 1) <> ""
            ReDim Riga(1 To 12)
            Sp = Split(Replace(.Cells(R1, 1), Chr(160), " "), " ") 'sostituisce carattere 160 con spazio
            L = LBound(Sp)
            U = UBound(Sp)
            'elabora prima riga
            Token = ""
            Do While Not IsNumeric(Sp(L))
                If Sp(L) <> "" Then Token = Token & Sp(L) & " "
                L = L + 1
            Loop
            Riga(1) = Left(Token, Len(Token) - 1)
            Token = ""
            Do While Left(Sp(L + 1), 1) <> "("
                If Sp(L) <> "" Then Token = Token & Sp(L) & " "
                L = L + 1
            Loop
            Riga(2) = Left(Token, Len(Token) - 1)
            Token = ""
            Do While L <= U
                If Sp(L) <> "" Then Token = Token & Sp(L) & " "
                L = L + 1
            Loop
            Riga(3) = Left(Token, Len(Token) - 1)
            'elabora seconda riga
            R1 = R1 + 1
            Sp = Split(Replace(Replace(.Cells(R1, 1), Chr(160), " "), ":", ": "), " ")
            L = LBound(Sp)
            U = UBound(Sp)
            Ri = 4
            Do While L <= U
                Token = ""
                If Right(Sp(L), 1) = ":" Then
                    L = L + 1
                    Do While Right(Sp(L), 1) <> ":" And L < U
                        If Sp(L) <> "" Then Token = Token & Sp(L) & " "
                        L = L + 1
                    Loop
                    Riga(Ri) = Token
                    Ri = Ri + 1
                End If
                If Right(Sp(L), 1) <> ":" Then L = L + 1
            Loop
            sDest.Cells(R2, 1).Resize(1, UBound(Riga) - LBound(Riga) + 1) = Riga
            R1 = R1 + 1
            R2 = R2 + 1
        Loop
    End With
    Set sOrig = Nothing
    Set sDest = Nothing
End Sub


Allego il file di esempio
https://www.dropbox.com/s/5ewyl1e089vw30p/ProntuarioTorrino_by_Z0K%21.xlsb?dl=0