Copiare da un sito e incollare su un foglio Excel in modo corretto

Anonimo

Esiste una funzione in excel oppure un modo alternativo al mio problema ?

come da foto allegata vi mostro che copiando da un sito questi dati , incollandoli sul mio foglio me li da incolonnati , esiste una funzione oppure un modo alternativo di averli sul mio foglio come sono stati copiati ?

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti

Risposta accettata dall'autore della domanda

Anonimo

Ciao Lupetto,

In effetti le partite Posticipate o Cancellate non devono essere presenti nella lista

Rigurdo alle partite completate o in corso NO devono restare , insieme a quelle che devono ancora iniziare che portano con se il loro orario di inizio .

Altra cosa importante che ho dimenticato di dirti e' la seguente : gli orari di inizio partite hanno tutte un'ora indietro rispetto al mio orario e non possono essere cambiati dal sito in questione , potresti magicamente aggiungere in automatico un'ora in piu' rispetto a loro ?

Questi giorni andavo molto di fretta e ho fatto un po di confusione , poco fa ho riflettuto bene sul tutto ed ecco la maschera finale di come dovrebbe essere fatta

si notano due colonne in piu che vanno lasciate libere per altre cose che servono a me e sarebbero le colonne D - L

altro punto importante e' la colonna H , siccome dipende se si scaricano dati regressi oppure futuri , se sono regressi danno il risultato , se sono futuri danno orario e dobbiamo separarli come da colonne B e QR .

Riguardo ad altre variazioni rimane come detto in precedenza.

Ho modificato il codice al fine di abbracciare le modifiche da te indicate e la revisione della disposizione dei dati da te richiesta

Pertanto, sostituisci il mio codice precedente con la seguente versione:

'========>>

Option Explicit

'-------->>

Public Sub Tester()

Dim SH As Worksheet 

Dim Rng As Range 

Dim dTime As Double 

Dim sStr As String 

Dim sScore As String 

Dim sHome\_Team As String, sAway\_Team, m As String 

Dim sLega As String 

Dim vOdds\_Home As Variant, vOdds\_Draw As Variant, vOdds\_Away As Variant 

Dim vHome\_Rank As Variant, vAway\_Rank As Variant 

Dim arrSplit As Variant, arrRisultato() As Long 

Dim i As Long, j As Long, k As Long, iRiga As Long 

Dim iPos As Long, jPos As Long, kPos As Long, pPos As Long, qPos As Long, rPos As Long, sPos As Long 

Dim tempPos As Long 

Dim LRow As Long 

Dim bHome As Boolean, bRank As Boolean, bScore As Boolean, bTime As Boolean 

Const iRigs\_Intestazioni As Long = 3              '&lt;&lt;=== Modifica 

Set SH = ActiveSheet 

With SH 

    LRow = .Range("A" & .Rows.Count).End(xlUp).Row 

    Set Rng = SH.Range("A2:A" & LRow) 

End With 

iRiga = iRigs\_Intestazioni + 1 

ReDim arrRisultato(1 To 2) 

For k = 1 To Rng.Cells.Count 

    j = j + 1 

    If InStr(1, Rng.Cells(k + 1), "post", vbTextCompare) Then 

        k = k + 3 

        bHome = True 

        GoTo JumpMatch 

    End If 

    sStr = Rng.Cells(k).Text 

    With SH 

        Select Case True 

            Case Left(sStr, 3) = Space(3) '\\ Nuova Lega 

                sLega = Trim(sStr) 

                bHome = True 

            Case Left(sStr, 1) = "W", Left(sStr, 1) = "L", Left(sStr, 1) = "D"  '\\ Form 

                If bHome Then 

                    .Cells(iRiga, "E") = Trim(sStr) 

                    .Cells(iRiga, "C") = sLega 

                    bHome = False 

                Else 

                    .Cells(iRiga, "K") = Trim(sStr) 

                    bHome = True 

                End If 

            Case InStr(2, sStr, ".", vbTextCompare)         '\\ Odds 

                pPos = InStr(2, sStr, ".", vbTextCompare) 

                vOdds\_Home = Trim(Left(sStr, pPos + 2)) 

                qPos = InStr(pPos + 2, sStr, ".", vbTextCompare) 

                vOdds\_Draw = Trim(Mid(sStr, qPos - 1, 4)) 

                rPos = InStr(qPos + 1, sStr, ".", vbTextCompare) 

                vOdds\_Away = Mid(sStr, rPos - 1, 99) 

                vOdds\_Away = Left(vOdds\_Away, Len(vOdds\_Away) - 2) 

                .Cells(iRiga, "M").Resize(1, 3).Value = Array(vOdds\_Home, vOdds\_Draw, vOdds\_Away) 

                iRiga = iRiga + 1 

                If j &lt; Rng.Cells.Count Then 

                End If 

                bHome = True 

            Case InStr(1, sStr, "post", vbTextCompare) 

                If iRiga = 25 Then Stop 

            Case Left(sStr, 4) = " ---" '\\ No Odds 

                .Cells(iRiga, "L").Resize(1, 3).Value = "-" 

                iRiga = iRiga + 1 

                bHome = True 

                .Cells(iRiga, "C") = sLega 

            Case Left(sStr, 1) = Space(1), Left(sStr, 2) = Space(2)  '\\ iPos Score\Risultato iPos 

                sStr = Trim(sStr) 

                If Left(sStr, 2) Like "##" Then 

                    vHome\_Rank = Left(sStr, 2) 

                    bRank = True 

                    iPos = 4 

                ElseIf IsNumeric(Left(sStr, 1)) Then 

                    vHome\_Rank = Left(sStr, 1) 

                    iPos = 3 

                    bRank = True 

                Else 

                    iPos = 1 

                End If 

                .Cells(iRiga, "F") = vHome\_Rank 

                vHome\_Rank = "" 

                If InStr(1, sStr, ":") Then 

                    jPos = InStr(1, sStr, ":") - 3 

                    sPos = 2 

                Else 

                    tempPos = InStr(1, sStr, "-") 

                    If IsNumeric(Mid(sStr, tempPos + 1, 1)) Then 

                        jPos = InStr(sStr, "-") - 2 

                        bScore = True 

                    Else 

                        jPos = InStr(tempPos + 1, sStr, "-") 

                        bScore = IsNumeric(Mid(sStr, jPos + 1, 1)) 

                        jPos = jPos - 2 

                    End If 

                End If 

                If InStr(1, Mid(sStr, jPos + 1, 3 + sPos), "-", vbTextCompare) Then 

                    sScore = Mid(sStr, jPos + 1, 3 + sPos) 

                    bScore = True 

                    arrSplit = Split(sScore, "-") 

                    For i = 0 To 1 

                        arrRisultato(i + 1) = CLng(arrSplit(i)) 

                    Next i 

                ElseIf InStr(1, Mid(sStr, jPos + 1, 3 + sPos), ":", vbTextCompare) Then 

                    bTime = True 

                    dTime = TimeValue(Mid(sStr, jPos + 1, 3 + sPos)) + 1 / 24 

                End If 

                If CBool(jPos) Then 

                    sHome\_Team = Trim(Mid(sStr, Application.Max(iPos, 1), jPos - iPos)) 

                    kPos = iPos + Len(sHome\_Team) + 5 

                Else 

                    jPos = InStr(sStr, ":") 

                    If CBool(jPos) Then 

                        sHome\_Team = Mid(sStr, iPos, jPos - 2 - iPos) 

                    End If 

                    kPos = iPos + Len(sHome\_Team) + 7 

                End If 

                .Cells(iRiga, "G") = sHome\_Team 

                If IsNumeric(Right(sStr, 2)) Then 

                    vAway\_Rank = Right(sStr, 2) 

                    bRank = True 

                ElseIf IsNumeric(Right(sStr, 1)) Then 

                    vAway\_Rank = Right(sStr, 1) 

                    bRank = True 

                End If 

                sAway\_Team = Mid(sStr, kPos + sPos, 99) 

                If bRank Then 

                    sAway\_Team = Left(sAway\_Team, InStrRev(sAway\_Team, " ") - 1) 

                    bRank = False 

                End If 

                .Cells(iRiga, "I") = sAway\_Team 

                .Cells(iRiga, "J") = vAway\_Rank 

                If bTime Then 

                    .Cells(iRiga, "H") = dTime 

                End If 

                If bScore Then 

                    .Cells(iRiga, "Q").Resize(1, 2).Value = arrRisultato 

                End If 

                vAway\_Rank = "" 

                iPos = 0 

                jPos = 0 

                sPos = 0 

                bScore = False 

                bTime = False 

        End Select 

    End With

JumpMatch:

Next k

End Sub

'<<========

Ho controllato questo codice, utilizzando i dati di martedì 9 agosto e ho ottento i seguenti risultati:

Ho quindi scaricato i dati di oggi, che comprendono 30 partite, di cui 8 posticipate. Eseguendo il codice rivisto, ottengo la seguente tabella:

Potresti scaricare il mio file di prova Lupetto202207811.xlsm

===

Regards,

Norman

0 commenti

56 risposte aggiuntive

Anonimo

2022-08-10T14:36:20+00:00

https://youtu.be/JkD1L5Q22JY

Questa risposta è stata tradotta automaticamente. Di conseguenza, potrebbero esserci errori grammaticali o espressioni strane.
La risposta è stata utile?

0 commenti Nessun commento

Anonimo

Ciao Lupetto,

Non ti ho dimenticato! Ti assicuro che ho tutte le intenzioni di pubblicare una procedura VBA il prima possibile ma sono stato molto impegnato altrove.

Come base per il mio codice proiettato, ho scaricato i dati relativi alle partite di calcio di ieri dal sito web da te indicato.

Come hai già scoperto, questo si traduce in un elenco a una colonna del genere:

     [![Immagine](https://learn-attachment.microsoft.com/api/attachments/edfc6df7-dbf2-4660-be46-0d78879b3a65?platform=QnA

Per organizzare questi dati in un formato utilizzabile, ho eseguito il seguente codice:

'========>>

Option Explicit

'-------->>

Public Sub Tester()

Dim SH As Worksheet 

Dim Rng As Range, rCell As Range 

Dim sStr As String 

Dim sScore As String, sTime As String, sDate As String 

Dim sHome\_Team As String, sAway\_Team, m As String 

Dim vOdds\_Home As Variant, vOdds\_Draw As Variant, vOdds\_Away As Variant 

Dim vHome\_Rank As Variant, vAway\_Rank As Variant 

Dim i As Long, iRiga As Long 

Dim iPos As Long, jPos As Long, kPos As Long, pPos As Long, qPos As Long, rPos As Long, sPos As Long 

Dim tempPos As Long 

Dim LastRow As Long 

Dim bHome As Boolean, bRank As Boolean, bScore As Boolean, bDate As Boolean 

Set SH = ActiveSheet 

With SH 

    lrow = .Range("A" & .Rows.Count).End(xlUp).Row 

    Set Rng = SH.Range("A2:A" & lrow) 

End With 

iRiga = 2 

For Each rCell In Rng.Cells 

    sStr = rCell.Text 

    Select Case True 

        Case Left(sStr, 3) = Space(3) '\\ Liga 

            SH.Cells(iRiga, "E") = Trim(sStr) 

            SH.Cells(iRiga, "E").Interior.Color = vbYellow 

            bHome = True 

            iRiga = iRiga + 1 

        Case Left(sStr, 1) = "W", Left(sStr, 1) = "L", Left(sStr, 1) = "D"  '\\ Form 

            If bHome Then 

                SH.Cells(iRiga, "E") = Trim(sStr) 

                bHome = False 

            Else 

                SH.Cells(iRiga, "K") = Trim(sStr) 

                bHome = True 

            End If 

        Case InStr(2, sStr, ".", vbTextCompare)         '\\ Odds 

            pPos = InStr(2, sStr, ".", vbTextCompare) 

            vOdds\_Home = Trim(Left(sStr, pPos + 2)) 

            qPos = InStr(pPos + 2, sStr, ".", vbTextCompare) 

            vOdds\_Draw = Trim(Mid(sStr, qPos - 1, 4)) 

            rPos = InStr(qPos + 1, sStr, ".", vbTextCompare) 

            vOdds\_Away = Mid(sStr, rPos - 1, 99) 

            vOdds\_Away = Left(vOdds\_Away, Len(vOdds\_Away) - 2) 

            SH.Cells(iRiga, "L").Resize(1, 3).Value = Array(vOdds\_Home, vOdds\_Draw, vOdds\_Away) 

            iRiga = iRiga + 1 

        Case Left(sStr, 4) = " ---" '\\ No Odds 

            SH.Cells(iRiga, "L").Resize(1, 3).Value = "-" 

            iRiga = iRiga + 1 

        Case Left(sStr, 1) = Space(1), Left(sStr, 2) = Space(2)  '\\ iPos Score\Risultato iPos 

            sStr = Trim(sStr) 

            If Left(sStr, 2) Like "##" Then 

                vHome\_Rank = Left(sStr, 2) 

                bRank = True 

                iPos = 4 

            ElseIf IsNumeric(Left(sStr, 1)) Then 

                vHome\_Rank = Left(sStr, 1) 

                iPos = 3 

                bRank = True 

            Else 

                iPos = 1 

            End If 

            SH.Cells(iRiga, "F") = vHome\_Rank 

            vHome\_Rank = "" 

            If InStr(1, sStr, ":") Then 

                jPos = InStr(1, sStr, ":") - 3 

                sPos = 2 

            Else 

                tempPos = InStr(1, sStr, "-") 

                If IsNumeric(Mid(sStr, tempPos + 1, 1)) Then 

                    jPos = InStr(sStr, "-") - 2 

                    bScore = True 

                Else 

                    jPos = InStr(tempPos + 1, sStr, "-") 

                    bScore = IsNumeric(Mid(sStr, jPos + 1, 1)) 

                    jPos = jPos - 2 

                End If 

            End If 

            sScore = Mid(sStr, jPos + 1, 3 + sPos) 

            If CBool(jPos) Then 

                sHome\_Team = Trim(Mid(sStr, Application.Max(iPos, 1), jPos - iPos)) 

                kPos = iPos + Len(sHome\_Team) + 5 

            Else 

                jPos = InStr(sStr, ":") 

                If CBool(jPos) Then 

                    sHome\_Team = Mid(sStr, iPos, jPos - 2 - iPos) 

                End If 

                kPos = iPos + Len(sHome\_Team) + 7 

            End If 

            SH.Cells(iRiga, "G") = sHome\_Team 

            If IsNumeric(Right(sStr, 2)) Then 

                vAway\_Rank = Right(sStr, 2) 

                bRank = True 

            ElseIf IsNumeric(Right(sStr, 1)) Then 

                vAway\_Rank = Right(sStr, 1) 

                bRank = True 

            End If 

            sAway\_Team = Mid(sStr, kPos + sPos, 99) 

            If bRank Then 

                sAway\_Team = Left(sAway\_Team, InStrRev(sAway\_Team, " ") - 1) 

                bRank = False 

            End If 

            SH.Cells(iRiga, "I") = sAway\_Team 

            SH.Cells(iRiga, "J") = vAway\_Rank 

            With SH.Cells(iRiga, "H") 

                .NumberFormat = "@" 

                .Value = CStr(sScore) 

            End With 

            vAway\_Rank = "" 

            iPos = 0 

            jPos = 0 

            sPos = 0 

    End Select 

Next rCell

End Sub

'<<========

Esequendo questa procedura, ottengo dati del genere:

  [![Immagine](https://learn-attachment.microsoft.com/api/attachments/eb96a69b-79c6-404e-b2ee-744d6ad23346?platform=QnA

Nota che, finora, ho considerato solo i dati di un solo giorno. Questi dati includevano già numerosi casi speciali e può darsi che i dati del giorno successivo presentino ulteriori problemi. Fino a quando non avrò il tempo di esaminare questi dati successivi, sarà necessario segnalare i problemi man mano che li incontrerai

Potresti scaricare il mio file di prova Luca20220810.xlsm

===

Regards,

Norman

0 commenti

Anonimo

2022-08-10T16:23:46+00:00

Ciao Luca,

Non ti ho dimenticato! Ti assicuro che ho tutte le intenzioni di pubblicare una procedura VBA il prima possibile ma sono stato molto impegnato altrove.

Come base per il mio codice proiettato, ho scaricato i dati relativi alle partite di calcio di ieri dal sito web da te indicato.

Come hai già scoperto, questo si traduce in un elenco a una colonna del genere:

Per organizzare questi dati in un formato utilizzabile, ho eseguito il seguente codice:

'========>>

Option Explicit

'-------->>

Public Sub Tester()

Dim SH As Worksheet

Dim Rng As Range, rCell As Range

Dim sStr As String

Dim sScore As String, sTime As String, sDate As String

Dim sHome_Team As String, sAway_Team, m As String

Dim vOdds_Home As Variant, vOdds_Draw As Variant, vOdds_Away As Variant

Dim vHome_Rank As Variant, vAway_Rank As Variant

Dim i As Long, iRiga As Long

Dim iPos As Long, jPos As Long, kPos As Long, pPos As Long, qPos As Long, rPos As Long, sPos As Long

Dim tempPos As Long

Dim LastRow As Long

Dim bHome As Boolean, bRank As Boolean, bScore As Boolean, bDate As Boolean

Set SH = ActiveSheet

With SH

lrow = .Range("A" & .Rows.Count).End(xlUp).Row

Set Rng = SH.Range("A2:A" & lrow)

End With

iRiga = 2

For Each rCell In Rng.Cells

sStr = rCell.Text

Select Case True

Case Left(sStr, 3) = Space(3) '\ Liga

SH.Cells(iRiga, "E") = Trim(sStr)

SH.Cells(iRiga, "E").Interior.Color = vbYellow

bHome = True

iRiga = iRiga + 1

Case Left(sStr, 1) = "W", Left(sStr, 1) = "L", Left(sStr, 1) = "D" '\ Form

If bHome Then

SH.Cells(iRiga, "E") = Trim(sStr)

bHome = False

Else

SH.Cells(iRiga, "K") = Trim(sStr)

bHome = True

End If

Case InStr(2, sStr, ".", vbTextCompare) '\ Odds

pPos = InStr(2, sStr, ".", vbTextCompare)

vOdds_Home = Trim(Left(sStr, pPos + 2))

qPos = InStr(pPos + 2, sStr, ".", vbTextCompare)

vOdds_Draw = Trim(Mid(sStr, qPos - 1, 4))

rPos = InStr(qPos + 1, sStr, ".", vbTextCompare)

vOdds_Away = Mid(sStr, rPos - 1, 99)

vOdds_Away = Left(vOdds_Away, Len(vOdds_Away) - 2)

SH.Cells(iRiga, "L").Resize(1, 3).Value = Array(vOdds_Home, vOdds_Draw, vOdds_Away)

iRiga = iRiga + 1

Case Left(sStr, 4) = " ---" '\ No Odds

SH.Cells(iRiga, "L").Resize(1, 3).Value = "-"

iRiga = iRiga + 1

Case Left(sStr, 1) = Space(1), Left(sStr, 2) = Space(2) '\ iPos Score\Risultato iPos

sStr = Trim(sStr)

If Left(sStr, 2) Like "##" Then

vHome_Rank = Left(sStr, 2)

bRank = True

iPos = 4

ElseIf IsNumeric(Left(sStr, 1)) Then

vHome_Rank = Left(sStr, 1)

iPos = 3

bRank = True

Else

iPos = 1

End If

SH.Cells(iRiga, "F") = vHome_Rank

vHome_Rank = ""

If InStr(1, sStr, ":") Then

jPos = InStr(1, sStr, ":") - 3

sPos = 2

Else

tempPos = InStr(1, sStr, "-")

If IsNumeric(Mid(sStr, tempPos + 1, 1)) Then

jPos = InStr(sStr, "-") - 2

bScore = True

Else

jPos = InStr(tempPos + 1, sStr, "-")

bScore = IsNumeric(Mid(sStr, jPos + 1, 1))

jPos = jPos - 2

End If

End If

sScore = Mid(sStr, jPos + 1, 3 + sPos)

If CBool(jPos) Then

sHome_Team = Trim(Mid(sStr, Application.Max(iPos, 1), jPos - iPos))

kPos = iPos + Len(sHome_Team) + 5

Else

jPos = InStr(sStr, ":")

If CBool(jPos) Then

sHome_Team = Mid(sStr, iPos, jPos - 2 - iPos)

End If

kPos = iPos + Len(sHome_Team) + 7

End If

SH.Cells(iRiga, "G") = sHome_Team

If IsNumeric(Right(sStr, 2)) Then

vAway_Rank = Right(sStr, 2)

bRank = True

ElseIf IsNumeric(Right(sStr, 1)) Then

vAway_Rank = Right(sStr, 1)

bRank = True

End If

sAway_Team = Mid(sStr, kPos + sPos, 99)

If bRank Then

sAway_Team = Left(sAway_Team, InStrRev(sAway_Team, " ") - 1)

bRank = False

End If

SH.Cells(iRiga, "I") = sAway_Team

SH.Cells(iRiga, "J") = vAway_Rank

With SH.Cells(iRiga, "H")

.NumberFormat = "@"

.Value = CStr(sScore)

End With

vAway_Rank = ""

iPos = 0

jPos = 0

sPos = 0

End Select

Next rCell

End Sub

'<<========

Esequendo questa procedura, ottengo dati del genere:

Nota che, finora, ho considerato solo i dati di un solo giorno. Questi dati includevano già numerosi casi speciali e può darsi che i dati del giorno successivo presentino ulteriori problemi. Fino a quando non avrò il tempo di esaminare questi dati successivi, sarà necessario segnalare i problemi man mano che li incontrerai

Potresti scaricare il mio file di prova Luca20220810.xlsm

===

Regards,

Norman

Grandissimo Norman , ero certo al 100 % di poter contare su di te , ero certissimo che avresti risolto , Vladimiro ti adorava .

Ho visto al volo che va benissimo , c'e' solo qualche cosina da spostare , in questo momento non ho tempo a disposizione , appena mi libero ti spiego cosa .

Best Regards
La risposta è stata utile?

0 commenti Nessun commento
Anonimo

2022-08-10T16:25:47+00:00

Ciao Molte grazie per la tua domanda, mi chiamo Tim e farò del mio meglio per risolvere il tuo problema. Ho messo un link qui sotto che può aiutarti a ottenere i dati da un sito Web per Excel. Nota: questo è un sito Web non Microsoft. La pagina sembra fornire informazioni accurate e sicure. Attento per annunci sul sito che possono pubblicizzare prodotti frequentemente classificati come PUP (Prodotti potenzialmente indesiderati). Ricerca accurata su qualsiasi prodotto pubblicizzato sul sito prima di te decidere di scaricarlo e installarlo. Restituisci alla comunità. Aiuta la persona successiva che ha questo problema indicando che questa risposta ha risolto il tuo problema. Fare clic su Sì o No di seguito. Non vedo l'ora di sentirti. Grazie mille. Tim

Questa risposta è stata tradotta automaticamente. Di conseguenza, potrebbero esserci errori grammaticali o espressioni strane.

Se non vado errato , ho visitato la link da lei suggeritami e cosa me ne dovrei fare io del censimento della popolazione americana ?

Come importare dati da un sito che lascia operare tramite query lo so benissimo ma non e' il sito che interessa a me , il sito da me indicato ha dei parametri ben precisi che a me interessano purtroppo non lascia aggangiare la query.

Ho in parte risolto con lo strumento trasforma e recupera di Excel , nel frattempo sono in attesa di un vero Maestro che sono certo mi rendera' molto piu' facile il tutto .

Grazie e buona giornta.
La risposta è stata utile?

0 commenti Nessun commento