Una famiglia di software per fogli di calcolo Microsoft con strumenti per l'analisi, la creazione di grafici e la comunicazione dei dati.
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 '<<=== 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 < 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