Condividi:        

Aggiornare Classifica Kart

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Aggiornare Classifica Kart

Postdi robygragio » 09/12/12 13:26

Salve a tutti e la prima volta che scrivo su questo forum trovato per caso, vorrei sapere se qualchew anima pia che mi puo aiutare a risolvere un mio grosso problema, devo aggiornare una classifica di gare di kart avendo gia i risultati in un foglio, essendo a digiuno di exel, se ce qualcuno che puo spiegarmelo glie ne saro molto grato,

il file e questo http://www.mediafire.com/view/?5zcxwm9582yphgy
Win7 + Office 2007 Ita
robygragio
Utente Junior
 
Post: 29
Iscritto il: 09/12/12 12:58

Sponsor
 

Re: Aggiornare Classifica Kart

Postdi Flash30005 » 10/12/12 09:47

Ciao Robygragio e benvenuto nel Forum

Credo che oltre al file dovresti spiegare qualcosa in più...
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Aggiornare Classifica Kart

Postdi robygragio » 10/12/12 14:03

intanto grazie per avermi risposto, per quando riguarda il file exel che ho postato, praticamente ho un foglio con tutte le classifiche che dovrebbero aggiornarsi prendendo i dati negli altri fogli per ogni gara, i dati li copio io da un foglio txt e li incollo in exel per ogni gara non so se sono stato chiaro.
Win7 + Office 2007 Ita
robygragio
Utente Junior
 
Post: 29
Iscritto il: 09/12/12 12:58

Re: Aggiornare Classifica Kart

Postdi wallace&gromit » 10/12/12 14:08

mancano ancora un po' di informazioni su come devono risultare alla fine le classifiche (ordine sempre uguale alla base data o graduatoria aggiornata in funzione del punteggio) e su quali valori si determinano le graduatorie:
per es. come si computano gara1, gara2, qualifica... ecc.

Edit: queste informazioni sono determinanti per sapere se si possa lavorare con formule o se conviene passare alle macro
Office2016 + 2019 su win11
Avatar utente
wallace&gromit
Utente Senior
 
Post: 2174
Iscritto il: 16/01/12 14:21

Re: Aggiornare Classifica Kart

Postdi robygragio » 10/12/12 14:54

Praticamente la "Classifica Pilota Gara" dovrebbe sommare i punti di gara 1 e 2 per ogni pilota di ogni Tracciato (Lonato, castrezzato, eccc..), la "Classifica Piloti" deve sommare tutti i punti di tutti i tracciati per ogni pilota, spero di essermi spiegato bene :cry:
Win7 + Office 2007 Ita
robygragio
Utente Junior
 
Post: 29
Iscritto il: 09/12/12 12:58

Re: Aggiornare Classifica Kart

Postdi wallace&gromit » 10/12/12 15:08

vanno bene ordinate come sono (facile) oppure ogni volta vorresti che si adattassero con in testa chi è al comando?
Nel secondo caso qualcosa del genere lo ha pubblicato Probe Potter qui: viewtopic.php?f=26&t=95206
tutto solo con formule, ma parecchio complesse.
Penso che Flash saprebbe fare delle macro con meno dispendio di energia.
Office2016 + 2019 su win11
Avatar utente
wallace&gromit
Utente Senior
 
Post: 2174
Iscritto il: 16/01/12 14:21

Re: Aggiornare Classifica Kart

Postdi robygragio » 10/12/12 15:14

intanto grazie che mi rispodi, lo avevo gia letto quel post ma non ce piu il file online cosi da vedere di riuscire ad adattarlo al mio caso
Win7 + Office 2007 Ita
robygragio
Utente Junior
 
Post: 29
Iscritto il: 09/12/12 12:58

Re: Aggiornare Classifica Kart

Postdi Anthony47 » 11/12/12 00:24

Per la classifica piloti, sul foglio Classifica:
In E3
Codice: Seleziona tutto
=SE.ERRORE(CERCA.VERT(C3;M2:N27;2;0);"")
poi copia verso il basso
In O3
Codice: Seleziona tutto
=SE.ERRORE(CERCA.VERT($M3;INDIRETTO(O$2&"!C24:K38");8;0)+CERCA.VERT($M3;INDIRETTO(O$2&"!C44:K58");8;0);"")
Poi copia verso dx, e copia tutta la prima riga verso il basso
Accertati che in O2 e successive l' intestazione corrisponda esattamente al nome del relativo foglio

Accertati che la formula in N3 e sottostanti comprenda i subtotali di tutti i circuiti elencati in O2 e successivi

Questo presuppone che il layout dei fogli di ogni circuito siano uguali a quelli che hai pubblicato; quindi e' opportuno che essi siano creati usando uno stesso "modello" di partenza

Per la classifica Squadra
In E23
Codice: Seleziona tutto
=MATR.SOMMA.PRODOTTO(--($D$3:$D$17=C23);$E$3:$E$17)
Poi copi verso il basso

Nulla hai detto sul significato e modalita' di calcolo di Gap, Starts, Poles, Wins, Podium e nulla ti suggerisco io; magari qualche appassionato di kart che sa interpretare...

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19183
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Aggiornare Classifica Kart

Postdi robygragio » 11/12/12 01:23

ti ringrazzio infinitamente anthony funziona tutto alla perfezione l'unica che non funziona e che non si mettono in ordine in base al punteggio forse sbaglio io qualcosa nel copiare, per quando riguarda il Gap sarebbe il punteggio che manca dalla primo calassificato, Starts sono le gare che un pilota gareggia , Poles e il primo delle qualifiche, Wins sono le vittorie che un pilota ha e in fine Podium sarebbero le volte che un pilota e arrivato tra i primi 3 in gara.
Win7 + Office 2007 Ita
robygragio
Utente Junior
 
Post: 29
Iscritto il: 09/12/12 12:58

Re: Aggiornare Classifica Kart

Postdi robygragio » 11/12/12 14:03

per quando riguarda il gap dei piloti ho risolto mettendo la formula.
Codice: Seleziona tutto
=N$3-E3
in F3
Win7 + Office 2007 Ita
robygragio
Utente Junior
 
Post: 29
Iscritto il: 09/12/12 12:58

Re: Aggiornare Classifica Kart

Postdi Anthony47 » 12/12/12 02:23

Questa macro rappresenta la mia interpretazione del problema; le scarne informazioni che hai fornito lasciano parecchi margini alla fantasia personale.
Codice: Seleziona tutto
Private Sub Worksheet_Activate()
Dim myRes(1 To 5), myGara1 As String, myGara2 As String, I As Long, J As Long, myQualif As String
'
'>>> Informazioni
myGara1 = "C25:K38"     '<<< Area dati Gara1, su ogni foglio Circuito
myGara2 = "C44:K58"     '<<< Idem Gara2
myQualif = "C4:J18"     '<<< Area qualifica
CPil = "B3:J17"         '<<< Area Elenco piloti su Classifica
'
For Each karter In Range(CPil).Offset(0, 1).Resize(, 1)
    For I = 2 To ThisWorkbook.Worksheets.Count
        With Sheets(I)
            'Gap
                On Error Resume Next
                '
                myRes(1) = myRes(1) + wmsec(Application.WorksheetFunction.VLookup(karter.Value, .Range(myGara1), 6, 0))
                myRes(1) = myRes(1) + wmsec(Application.WorksheetFunction.VLookup(karter.Value, .Range(myGara2), 6, 0))
            'Starts
            zzz = Application.WorksheetFunction.CountIf(.Range(myGara1), karter.Value)
                myRes(2) = myRes(2) + Application.WorksheetFunction.CountIf(.Range(myGara1), karter.Value)
                myRes(2) = myRes(2) + Application.WorksheetFunction.CountIf(.Range(myGara2), karter.Value)
            'poles
                myQT = Application.WorksheetFunction.VLookup(karter.Value, .Range(myQualif), 6, 0)
                If wmsec(myQT) = 0 And Not IsEmpty(myQT) Then myRes(3) = myRes(3) + 1
            'wins
                myGT = Application.WorksheetFunction.VLookup(karter.Value, .Range(myGara1), 6, 0)
                If wmsec(myGT) = 0 And Not IsEmpty(myGT) Then myRes(4) = myRes(4) + 1
                myGT = Application.WorksheetFunction.VLookup(karter.Value, .Range(myGara2), 6, 0)
                If wmsec(myGT) = 0 And Not IsEmpty(myGT) Then myRes(4) = myRes(4) + 1
            'podium
                If Application.WorksheetFunction.VLookup(karter.Value, .Range(myGara1), 8, 0) >= 18 Then myRes(5) = myRes(5) + 1
                If Application.WorksheetFunction.VLookup(karter.Value, .Range(myGara2), 8, 0) >= 18 Then myRes(5) = myRes(5) + 1
            End With
        Next I
karter.Offset(0, 3).Resize(1, 5) = myRes()
karter.Offset(0, 3).Value = karter.Offset(0, 3).Value / 24 / 3600
myRes(1) = Empty: myRes(2) = Empty: myRes(3) = Empty: myRes(4) = Empty: myRes(5) = Empty
Next karter
'Call Macro1     '****Richiama una macro per Ordinare il foglio 
End Sub


Function wmsec(ByVal fintimsm As String) As Double
Dim mSec As Integer, mySpl, mySpl2
fintimsm = Replace(fintimsm, "-", "0")
mySpl = Split(fintimsm, ".")
mySpl2 = Split(mySpl(LBound(mySpl)), ":")
wmsec = mySpl2(LBound(mySpl2)) * 60 + mySpl2(UBound(mySpl2)) + mySpl(UBound(mySpl)) / 1000

End Function

Tasto dx sul tab con nome fglio "Classifica", scegli Visualizza codice; copia il codice e incollalo nel frame di dx dell' editor delle macro che si e' aperto.
Personalizza le istruzioni marcate <<<, e sul foglio Classifica formatta le aree come da natura dei dati; in particolare F1:F17, dedicata al Gap sara' formattato come Categoria=Personalizzato e tipo=mm:ss,000
Per me infatti si tratta della somma dei vari "gap" contabilizzati su ogni circuito.
Tutte le volte che viene attivato il foglio Classifica, la macro ri-calcolera' i valori relativi a Classifica piloti.

Per la classifica a squadre, metti in E23 la formula
Codice: Seleziona tutto
=MATR.SOMMA.PRODOTTO(--($D$3:$D$17=$C23);E$3:E$17)
Copia poi verso destra e copia la prima riga di formule verso il basso.

Per quanto riguarda l' ordinamento, registrati una macro mentre esegui su foglio Classifica gli ordinamenti che ti servono; poi inserisci in coda alla macro Worksheet_Activate un richiamo a questa macro; basta eliminare l' apostrofo in testa all' istruzione marcata *** e usare nella "Call" il nome reale della macro (che sostituira' "Macro1" nella riga)

Ribadisco che e' importante che ogni foglio "circuito" abbia lo stesso layout e le stesse posizioni; se il numero di atleti puo' variare nel corso del campionato devi quindi riservare le righe, nelle aree Qualifica, Gara1 e Gara2 idonee per accomodare tutti i nominativi che possono partecipare alle qualifiche e alle gare.

Ciao, fai sapere.
Avatar utente
Anthony47
Moderatore
 
Post: 19183
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Aggiornare Classifica Kart

Postdi robygragio » 12/12/12 18:52

Ciao anthony, allora per quando riguarda il codice che tu mi hai scritto funziona tutto alla perfezione tranne che per il gap, praticamente il gap del foglio classifica non e la somma del tempo ma e la differenza di punti che mancano per arrivare primo in classifica, tipo antonio e primo con 86 punti romeo e secondo con 72 il gap e di 14 punti per arrivare primo, ho notato che se ce un foglio vuoto in piu mi sbaglia tutti i valori delle statistiche.
ti allego il file http://www.mediafire.com/?og6vsca8cow8396 senza il tuo codice cosi vedi cosa intendo per il gap e il file http://www.mediafire.com/?jwhnzvfcjf9gb93 con il tuo codice e le mie modifiche
per quando riguarda classifica a squadre o modificato la tua formula
Codice: Seleziona tutto
=MATR.SOMMA.PRODOTTO(--($D$3:$D$17=$C23);E$3:E$17)
per adattarla alle statistiche Starts, Poles, Wins e Podium di classifica a squadre.
intanto ti ringrazio per il tuo tempo speso ciao.
Win7 + Office 2007 Ita
robygragio
Utente Junior
 
Post: 29
Iscritto il: 09/12/12 12:58

Re: Aggiornare Classifica Kart

Postdi Anthony47 » 13/12/12 02:58

Ok.
Ho modificato la macro per non calcolare la colonna Gap e per convivere con eventuali altri fogli vuoti. Il nuovo codice (sostituisce integralmente il precedente):
Codice: Seleziona tutto
    Private Sub Worksheet_Activate()
    Dim myRes(1 To 5), myGara1 As String, myGara2 As String, I As Long, J As Long, myQualif As String
    '
    '>>> Informazioni
    myGara1 = "C25:K38"     '<<< Area dati Gara1, su ogni foglio Circuito
    myGara2 = "C44:K58"     '<<< Idem Gara2
    myQualif = "C4:J18"     '<<< Area qualifica
    CPil = "B3:J17"         '<<< Area Elenco piloti su Classifica
    '
    For Each karter In Range(CPil).Offset(0, 1).Resize(, 1)
        For I = 2 To ThisWorkbook.Worksheets.Count
            With Sheets(I)
                'Gap
                    On Error Resume Next
                    '
'                    myRes(1) = myRes(1) + wmsec(Application.WorksheetFunction.VLookup(karter.Value, .Range(myGara1), 6, 0))
'                    myRes(1) = myRes(1) + wmsec(Application.WorksheetFunction.VLookup(karter.Value, .Range(myGara2), 6, 0))
                'Starts
                zzz = Application.WorksheetFunction.CountIf(.Range(myGara1), karter.Value)
                    myRes(1) = myRes(1) + Application.WorksheetFunction.CountIf(.Range(myGara1), karter.Value)
                    myRes(1) = myRes(1) + Application.WorksheetFunction.CountIf(.Range(myGara2), karter.Value)
                'poles
                    myQt = Empty
                    myQt = Application.WorksheetFunction.VLookup(karter.Value, .Range(myQualif), 6, 0)
                    If wmsec(myQt) = 0 And Not IsEmpty(myQt) Then myRes(2) = myRes(2) + 1
                'wins
                    myGT = Empty
                    myGT = Application.WorksheetFunction.VLookup(karter.Value, .Range(myGara1), 6, 0)
                    If wmsec(myGT) = 0 And Not IsEmpty(myGT) Then myRes(3) = myRes(3) + 1
                    myGT = Application.WorksheetFunction.VLookup(karter.Value, .Range(myGara2), 6, 0)
                    If wmsec(myGT) = 0 And Not IsEmpty(myGT) Then myRes(3) = myRes(3) + 1
                'podium
                    myGT = Empty
                    myGT = Application.WorksheetFunction.VLookup(karter.Value, .Range(myGara1), 8, 0)
                    If myGT >= 18 Then myRes(4) = myRes(4) + 1
                    myGT = Application.WorksheetFunction.VLookup(karter.Value, .Range(myGara2), 8, 0)
                    If myGT >= 18 Then myRes(4) = myRes(4) + 1

            End With

            Next I
    karter.Offset(0, 4).Resize(1, 4) = myRes()
'    karter.Offset(0, 3).Value = karter.Offset(0, 3).Value / 24 / 3600
    myRes(1) = Empty: myRes(2) = Empty: myRes(3) = Empty: myRes(4) = Empty: myRes(5) = Empty
    Next karter
    'Call Macro1     '****Richiama una macro per Ordinare il foglio
    End Sub


   Function wmsec(ByVal fintimsm As String) As Double
    Dim mSec As Integer, mySpl, mySpl2
    If fintimsm = "" Then wmsec = 0: Exit Function
    fintimsm = Replace(fintimsm, "-", "0")
    mySpl = Split(fintimsm, ".")
    mySpl2 = Split(mySpl(LBound(mySpl)), ":")
    wmsec = mySpl2(LBound(mySpl2)) * 60 + mySpl2(UBound(mySpl2)) + mySpl(UBound(mySpl)) / 1000

    End Function

Per il calcolo del gap suggerisco di usare in E3
Codice: Seleziona tutto
=E3-MAX(E$3:E$17)
da copiare poi verso il basso.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19183
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Aggiornare Classifica Kart

Postdi robygragio » 13/12/12 18:26

Ciao Anthony, funziona tutto alla perfezione e ti dico mille grazie per l'aiuto che mi hai dato, ti devo chiedere un ultima favore :) poi giuro che non ti faccio perdere piu tempo,
mi sono accorto adesso che ho usato la tua formula
Codice: Seleziona tutto
=SE.ERRORE(CERCA.VERT($M3;INDIRETTO(O$2&"!C24:K38");8;0)+CERCA.VERT($M3;INDIRETTO(O$2&"!C44:K58");8;0);"")
per calcolare i punti della squadra per ogni gara adattandola al mio caso con questa formula
Codice: Seleziona tutto
=SE.ERRORE(CERCA.VERT($M23;INDIRETTO(O$22&"!D24:K38");7;0)+CERCA.VERT($M23;INDIRETTO(O$22&"!D44:K58");7;0);"")
ma mi aggiunge solo il primo pilota che trova per gara per ogni squadra il secondo non me lo calcola, o provato in tutti modi a modificarla ma non sono riuscito ad arrivare al mio scopo :cry:
Win7 + Office 2007 Ita
robygragio
Utente Junior
 
Post: 29
Iscritto il: 09/12/12 12:58

Re: Aggiornare Classifica Kart

Postdi Anthony47 » 14/12/12 00:45

Per la classifica a squadra per circuito, in O23:
Codice: Seleziona tutto
=SE(O$22<>"";SOMMA.SE(INDIRETTO(O$22&"!D25:D58");$M23;INDIRETTO(O$22&"!J25:J58"));0)
Poi copia "in lungo e largo".
Metterai l' intestazione in riga22 solo se il foglio con quel nome e' presente (anche se non e' ancora compilato)
Immagine

Uploaded with ImageShack.us

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19183
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Aggiornare Classifica Kart

Postdi robygragio » 14/12/12 14:51

grazie ancora anthony adesso e perfetto l'unica cosa con non andava (ma e colpa mia) che aggiungendo i dati reali mi sballava le vittorie, perche nel codice che mi hai dato hai calcolato le vittorie in base al tempo e quando un pilota non giungeva al traguardo per rotturra non ce il tempo finale ma ce la scritta ritirato o il tipo di rotttura, e il tuo codice vedendo che non trova il tempo mi assegnava le vittorie anche a quelli ritirati ho modificato il tuo codice delle vittorie in questo modo
Codice: Seleziona tutto
     'wins
              myGT = Empty
              myGT = Application.WorksheetFunction.VLookup(karter.Value, .Range(myGara1), 8, 0)
              If myGT = 40 Then myRes(3) = myRes(3) + 1
              myGT = Application.WorksheetFunction.VLookup(karter.Value, .Range(myGara2), 8, 0)
              If myGT = 40 Then myRes(3) = myRes(3) + 1

non so se e corretto ma sembra che funge.
Win7 + Office 2007 Ita
robygragio
Utente Junior
 
Post: 29
Iscritto il: 09/12/12 12:58

Re: Aggiornare Classifica Kart

Postdi Anthony47 » 15/12/12 19:55

Se funge allora va bene :D :D

Ciao!
Avatar utente
Anthony47
Moderatore
 
Post: 19183
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Aggiornare Classifica Kart

Postdi robygragio » 15/12/12 21:31

granzie tante Anthony :D
Win7 + Office 2007 Ita
robygragio
Utente Junior
 
Post: 29
Iscritto il: 09/12/12 12:58


Torna a Applicazioni Office Windows


Topic correlati a "Aggiornare Classifica Kart":


Chi c’è in linea

Visitano il forum: Marius44 e 35 ospiti