formule excel per sostituzioni automatiche fantacalcio

[Flash30005]

Ok,
In una prima analisi sembrerebbe che questa macro risolva

Codice: Seleziona tutto

Sub InsPanch()
ContaA = 0
ContaG = 0
For RR = 4 To 6
If Range("E" & RR).Value <> "" Then
ContaG = ContaG + 1
Else
GoTo saltaRR1
End If
If Range("E" & RR).Value <> "" And (Range("G" & RR).Value = "-" Or Range("G" & RR).Value = 0) Then
ContaA = ContaA + 1
End If
Next RR
saltaRR1:
For RR = 4 To 6
    If ContaA > 0 Then
        MyC = Evaluate("COUNTIF(E4:E6,H" & RR & ")")
        If MyC = 0 Then
            If Range("J" & RR).Value <> "-" And Range("J" & RR).Value <> "" Then
                ContaA = ContaA - 1
                Range("E" & ContaG + 4).Value = Range("H" & RR).Value
                Range("G" & ContaG + 4).Value = Range("J" & RR).Value
                ContaG = ContaG + 1
            End If
        End If
    End If
Next RR
For RRC = 8 To 26 Step 9
ContaA = 0
ContaG = 0
For RR = RRC To RRC + 7
If Range("E" & RR).Value <> "" Then
ContaG = ContaG + 1
Else
GoTo saltaRR2
End If
If Range("E" & RR).Value <> "" And (Range("G" & RR).Value = "-" Or Range("G" & RR).Value = 0) Then
ContaA = ContaA + 1
End If
Next RR
saltaRR2:
For RR = 8 To 15
    If ContaA > 0 Then
        MyC = Evaluate("COUNTIF(E" & RRC & ":E" & RRC + 7 & ",H" & RR & ")")
        If MyC = 0 Then
            If Range("J" & RR).Value <> "-" And Range("J" & RR).Value <> "" Then
                ContaA = ContaA - 1
                Range("E" & ContaG + RRC).Value = Range("H" & RR).Value
                Range("G" & ContaG + RRC).Value = Range("J" & RR).Value
                ContaG = ContaG + 1
            End If
        End If
    End If
Next RR
Next RRC

End Sub

Se incontri problemi descrivi quali

ciao

[marmotta87]

Ho trovato due errori:
-il massimo di tre sostituzioni non c'è perchè provando a simulare 4 titolari senza voto mi cambia tutti e 4...
-i cambi effettuati avvengono sempre utilizzando le righe dei difensori, ad es se non gioca un centrocampista o un attaccante la macro prende i valori in qualsiasi dei sostituti difensori...

[Flash30005]

...
se non gioca un centrocampista o un attaccante la macro prende i valori in qualsiasi dei sostituti difensori...

La macro prende i valori dei sostituti difensori o deve prendere sempre i sostituti difensori?
Attualmente mi risulta che prende il sostituto di ruolo (difensore se difensore, centrocampista se centrocampista etc).

[Anthony47]

Pe me cambi la formula con cui calcoli il punteggio da mettere in colonna G; quindi in G2

Codice: Seleziona tutto

=SE(VAL.ERRORE(INDICE(PAGELLE!$A:$AG;CONFRONTA(CUCS!E4;PAGELLE!$B:$B;);31));SE(E4<>"";"-";"");INDICE(PAGELLE!$A:$AG;CONFRONTA(CUCS!E4;PAGELLE!$B:$B;);31))


Poi copi verso il basso.
In questo modo ricrei il formato precedente e usi le soluzioni precedenti.

Ciao

[marmotta87]

no flash..com'è fatta adesso la macro prende sempre i difensori qualsiasi sia il cambio....

[Flash30005]

E' vero per un refuso della macro precedente prendeva sempre i difensori
La ripropongo anche se non c'è il limite delle 3 sostituzioni in quanto non conosco le regole e anche perché penso che l'utente sappia che sta inserendo più di tre titolari senza "voto"

Codice: Seleziona tutto

Sub InsPanch()
ContaA = 0
ContaG = 0
For RR = 4 To 6
If Range("E" & RR).Value <> "" Then
ContaG = ContaG + 1
Else
GoTo saltaRR1
End If
If Range("E" & RR).Value <> "" And (Range("G" & RR).Value = "-" Or Range("G" & RR).Value = 0) Then
ContaA = ContaA + 1
End If
Next RR
saltaRR1:
For RR = 4 To 6
    If ContaA > 0 Then
        MyC = Evaluate("COUNTIF(E4:E6,H" & RR & ")")
        If MyC = 0 Then
            If Range("J" & RR).Value <> "-" And Range("J" & RR).Value <> "" Then
                ContaA = ContaA - 1
                Range("E" & ContaG + 4).Value = Range("H" & RR).Value
                Range("G" & ContaG + 4).Value = Range("J" & RR).Value
                ContaG = ContaG + 1
            End If
        End If
    End If
Next RR
For RRC = 8 To 26 Step 9
ContaA = 0
ContaG = 0
For RR = RRC To RRC + 7
    If Range("E" & RR).Value <> "" Then
        ContaG = ContaG + 1
    Else
        GoTo saltaRR2
    End If
    If Range("E" & RR).Value <> "" And (Range("G" & RR).Value = "-" Or Range("G" & RR).Value = 0) Then
        ContaA = ContaA + 1
    End If
Next RR
saltaRR2:
For RR = RRC To RRC + 7
    If ContaA > 0 Then
        MyC = Evaluate("COUNTIF(E" & RRC & ":E" & RRC + 7 & ",H" & RR & ")")
        If MyC = 0 Then
            If Range("J" & RR).Value <> "-" And Range("J" & RR).Value <> "" Then
                ContaA = ContaA - 1
                Range("E" & ContaG + RRC).Value = Range("H" & RR).Value
                Range("G" & ContaG + RRC).Value = Range("J" & RR).Value
                ContaG = ContaG + 1
            End If
        End If
    End If
Next RR
Next RRC

End Sub

Ciao

[marmotta87]

Così potrebbe andare, peccato per il limite di 3 perchè mi verrebbe molto utile.
Vorrei chiederti una cosa per favore, è possibile avere una macro che azzera la macro di prima?
mi spiego meglio.....io ho messo un pulsante CALCOLA che mi esegue la macro da te appena inviata, ho un pulsante AZZERA che dovrebbe fare un passo indietro, ovvero annullare la macro??
grazie

[Flash30005]

Questa macro ripristina lo stato precedente alle sostituzioni

Codice: Seleziona tutto

Sub Ripristina()
For RR = 4 To 6
    MyC = Evaluate("COUNTIF(H4:H6,E" & RR & ")")
    If MyC > 0 And Range("E" & RR).Value <> "" Then Range("E" & RR & ":G" & RR).ClearContents
    If Range("E" & RR).Value = "" Then
        Range("F6:G6").Copy Destination:=Range("F" & RR)
    End If
Next RR
SaltaRR1:
For RRC = 8 To 26 Step 9
RCI = RRC
RIF = RRC + 7
If RRC = 26 Then RIF = RRC + 5
For RR = RRC To RIF
    MyC = Evaluate("COUNTIF(H" & RCI & ":H" & RIF & ",E" & RR & ")")
    If MyC > 0 And Range("E" & RR).Value <> "" Then Range("E" & RR & ":G" & RR).ClearContents
    If Range("E" & RR).Value = "" Then
        Range("F24:G24").Copy Destination:=Range("F" & RR)
    End If
Next RR
SaltaRRC:
Next RRC
End Sub

Per quanto riguarda il controllo delle sostituzioni puoi inserire questo codice nel Vba del foglio CUCS (non modulo)

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
Area = "E4:E31"
If Not Application.Intersect(Target, Range(Area)) Is Nothing Then
Application.EnableEvents = False
UR1 = Range("E6").End(xlUp).Row
UR2 = Range("E15").End(xlUp).Row
UR3 = Range("E24").End(xlUp).Row
UR4 = Range("E31").End(xlUp).Row
MyC1 = Evaluate("COUNTIF(G4:G" & UR1 & "," & """-""" & ")")
MyC2 = Evaluate("COUNTIF(G8:G" & UR2 & "," & """-""" & ")")
MyC3 = Evaluate("COUNTIF(G17:G" & UR3 & "," & """-""" & ")")
MyC4 = Evaluate("COUNTIF(G26:G" & UR4 & "," & """-""" & ")")
Somma = MyC1 + MyC2 + MyC3 + MyC4
If Somma > 3 Then
MsgBox "Numero sostituzioni = " & Somma
End If
Application.EnableEvents = True
End If
End Sub

Ciao

EDIT ore 00:40 - aggiunta macro controllo sostituzioni

[marmotta87]

Grazie mille flash..sei un grande!!
un'ultima cosa, è possibile fare in modo che il ripristino avvenga senza che si apra la finestra 4 sostituzioni?

[jackbattaglia]

Ciao,
sono nuovo in questo forum,
potreste aiutarmi ad applicare il tutto nel mio file perchè non riesco,
ho realizzato un file excel con macro per assegnare i voti del fantacalcio in automatico a tutti i giocatori di una rosa e successivamente li filtro per titolari e riserve in base al colore delle celle.
Fin qui tutto ok.
Il mio problema è identico al post ma non riesco a realizzarlo.
potreste gentilmente creare dei pulsanti con macro per raggiungere il risultato ( voti riserve in ordine di ruolo )
Allego il file https://www.dropbox.com/s/t9kc1927k76tjcn/2013.xlsx.
Spero possiate aiutrami
Grazie