Condividi:        

help formule e macro per programma fantacalcio

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

Re: help formule e macro per programma fantacalcio

Postdi scirea1976 » 10/11/10 15:38

Anthony47 ha scritto:Nel tuo esempio hai titolari senza voto un P, un D e un C; la formula ti inserisce una riserva P, una D e una C.
Dove e' l' errore?

Ciao


L'errore è che se una riserva in questo caso (D Portanova) è senza voto, deve inserire l'altra (D Silvestre), prima di procedere con un eventuale altra sostituzione.
Praticamente il ragionamento che dovrebbe fare la formula è questo:
1) P Sirigu senza voto subentra P Manninger prende il voto Sostituzione OK
2) D Capuano senza voto subentra D Portanova senza voto Sostituzione OK
dopo questo passagio, Portanova non prende voto quindi la sostituzione va comunque contata ai fini delle tre sostituzioni massime consentite, e la formula deve cercare un'altra D nelle celle B15:B21 in questo caso Silvestre.
3) D Portanova senza voto subentra D Silvestre Sostituzione OK

A questo punto contando le sostituzioni sono gia 3 e quindi C Giaccherini non puo essere sostituito.
ciao e grazie per la pazienza spero tu possa aiutarmi. :cry:
scirea1976
Utente Junior
 
Post: 21
Iscritto il: 08/11/10 04:44

Sponsor
 

Re: help formule e macro per programma fantacalcio

Postdi Anthony47 » 10/11/10 22:21

Mah... insomma vuoi la sostituzione della sostituzione?
In E15 del tuo foglio
Codice: Seleziona tutto
=SE(E(SOMMA(((E$3:E$13="-"))*(B$3:B$13=B15))>0;SOMMA(((E$3:E$13="-"))*(B$3:B$13=B15))>=SOMMA((B$15:B15=B15)*((D$15:D15<>"-"))));SE(E(D15<>"+-";SOMMA(--(LUNGHEZZA(E$14:E14)>0))<3);D15;"");"")
Ricorda Contr-Maiusc-Enter

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

Re: help formule e macro per programma fantacalcio

Postdi scirea1976 » 11/11/10 03:43

Anthony47 ha scritto:Mah... insomma vuoi la sostituzione della sostituzione?
In E15 del tuo foglio
Codice: Seleziona tutto
=SE(E(SOMMA(((E$3:E$13="-"))*(B$3:B$13=B15))>0;SOMMA(((E$3:E$13="-"))*(B$3:B$13=B15))>=SOMMA((B$15:B15=B15)*((D$15:D15<>"-"))));SE(E(D15<>"+-";SOMMA(--(LUNGHEZZA(E$14:E14)>0))<3);D15;"");"")
Ricorda Contr-Maiusc-Enter

Ciao

Si perfetto , sembra funzionare alla perfezione :lol: .. domani la provo con diversi casi e poi ti faccio sapere.. grazie mille ... :lol:
scirea1976
Utente Junior
 
Post: 21
Iscritto il: 08/11/10 04:44

Re: help formule e macro per programma fantacalcio

Postdi gigilatrottola » 11/11/10 10:46

Per gigilatrottola:
secondo me la cosa piu' semplice e' che copi da Calendario nei singoli fogli; nell' arco di una stagione non e' uno sfrorzo sovrumano.
Alternativamente:
-assegni ai nomi la stessa desinenza che hai usato in Calendario, cioe ' 1A, 2A, etc (invece che 1^, 2^, etc)
-vai su foglio 1° e inserisci in R15 la formula

Codice: Seleziona tutto
=SCARTO(calendario!$A$1;CONFRONTA("Campionato: "&STRINGA.ESTRAI(CELLA("nomefile");TROVA("]";CELLA("nomefile"))+1;99);calendario!$A:$A;0)+RIF.RIGA(A1)-1;RIF.COLONNA(A1)-1)
-copi R15; selezioni R15:S19; tenendo pigiato Shift (Maiusc) selezioni il tab dell' ultimo foglio di giornata (4A nell' esempio, oppure 36A se il file e' completo; tutti i fogli sembreranno selezionati); fai Contr-v per incollare la formula.
-vai nell' editor del vba; nella finestra Progetto - VBAProject fai doppioclick sulla voce ThisWorkbook; inserisci questa macro:

Codice: Seleziona tutto
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Calculate
End Sub
Tieni presente pero' che quando hai attivo un qualsiasi foglio, su tutti i fogli saranno in quel momento presenti le stesse formazioni; non so quanto questo ha impatto sulla tua architettura dati.


grazie mille per la risposta, come sempre gentilissimo....
gigilatrottola
Utente Senior
 
Post: 190
Iscritto il: 10/06/06 09:58

Re: help formule e macro per programma fantacalcio

Postdi gigilatrottola » 16/11/10 00:32

eccomi qua, di nuovo a dare fastidio.....ma non ci riesco proprio....ecco il nuovo quesito:
vorrei fare una formattazione condizionale e fare uscire sulla colonna evidenziata di verde, le frecce , in caso di guadagno di posizione in classifica, rispetto alla settimana precedente freccia verde, in caso di perdida freccia rossa, in caso di rimanenza della stessa posizione , freccia gialla.
logicamente io ho una macro che mi mette in ordine la classifica

mi aiutate cortesemente?

ecco il file
http://www.megaupload.com/?d=9RQZ09WN

buona notte a tutti.
gigilatrottola
Utente Senior
 
Post: 190
Iscritto il: 10/06/06 09:58

Re: help formule e macro per programma fantacalcio

Postdi Flash30005 » 16/11/10 09:55

Il file non è al momento disponibile
prova anche con questo server

Ciao
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: help formule e macro per programma fantacalcio

Postdi gigilatrottola » 16/11/10 10:37

ok flash e grazie il suggerimento...ecco il file

http://rapidshare.com/files/431161301/e ... sifica.xls
gigilatrottola
Utente Senior
 
Post: 190
Iscritto il: 10/06/06 09:58

Re: help formule e macro per programma fantacalcio

Postdi scirea1976 » 16/11/10 23:59

scirea1976 ha scritto:
Anthony47 ha scritto:Mah... insomma vuoi la sostituzione della sostituzione?
In E15 del tuo foglio
Codice: Seleziona tutto
=SE(E(SOMMA(((E$3:E$13="-"))*(B$3:B$13=B15))>0;SOMMA(((E$3:E$13="-"))*(B$3:B$13=B15))>=SOMMA((B$15:B15=B15)*((D$15:D15<>"-"))));SE(E(D15<>"+-";SOMMA(--(LUNGHEZZA(E$14:E14)>0))<3);D15;"");"")
Ricorda Contr-Maiusc-Enter

Ciao

Si perfetto , sembra funzionare alla perfezione :lol: .. domani la provo con diversi casi e poi ti faccio sapere.. grazie mille ... :lol:


Tutto ok... provata e riprovata, la formula è perfetta.. grazie Anthony47 :lol: :lol:
scirea1976
Utente Junior
 
Post: 21
Iscritto il: 08/11/10 04:44

Re: help formule e macro per programma fantacalcio

Postdi Flash30005 » 17/11/10 02:00

gigilatrottola ha scritto:....
in caso di guadagno di posizione in classifica, rispetto alla settimana precedente...
mi aiutate cortesemente?
..


Vorrei aiutarti ma ho guardato in lungo e in largo il file senza trovare alcuna traccia della settimana precedente :roll:

Fai sapere
Ciao
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: help formule e macro per programma fantacalcio

Postdi Anthony47 » 17/11/10 03:10

Per facilitare la comprensione della discussione si chiede ad altri utenti, diversi da gigilatrottola, di NON INSERIRSI ulteriormente; se necessario aprire una nuova discussione inserendo il link a questa.

Ciao a tutti.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: help formule e macro per programma fantacalcio

Postdi gigilatrottola » 17/11/10 09:36

quindi mi dici di creare una classifica provvisoria a parte per poter fare il confronto?

va bene come ho fatto?
ecco il file

http://rapidshare.com/files/431356218/e ... sifica.xls

ps se così fosse ogni aggiornamento di classifica faccio il copia/incolla nella classifica provvisoria (anche con una macro)?

ciao e buona giornata a tutti.
gigilatrottola
Utente Senior
 
Post: 190
Iscritto il: 10/06/06 09:58

Re: help formule e macro per programma fantacalcio

Postdi Flash30005 » 17/11/10 13:02

Rileggendo meglio ho notato che hai realizzato una macro di ordinamento pertanto ho pensato che non c'è bisogno di avere una classifica precedente perché è sufficiente con un espediente memorizzare squadra e posizione prima dell'ordinamento e confrontare con la posizione dopo l'ordinamento.
Questa è la macro che lavora solo sulla tabella principale.

Codice: Seleziona tutto
Public VettSqP(10), VettSqA(10) As String, VettRP(10), VettRA(10) As Integer

Sub Valuta()
Worksheets("Attuale").Range("J5:J14").Interior.ColorIndex = 34
For RR = 5 To 14
VettSqP(RR - 4) = Worksheets("Attuale").Range("A" & RR).Value
VettRP(RR - 4) = RR
Next RR
'----------------- Macro ordinamento classifica

Call ordinamento

'------------------Fine Macro ordinamento
For RR = 5 To 14
VettSqA(RR - 4) = Worksheets("Attuale").Range("A" & RR).Value
VettRA(RR - 4) = RR
Next RR
For SqP = 1 To 10
    For SqA = 1 To 10
        If VettSqP(SqP) = VettSqA(SqA) Then
        Diff = VettRP(SqP) - VettRA(SqA)
        If Diff < 0 Then Worksheets("Attuale").Range("J" & SqA + 4).Interior.ColorIndex = 3
        If Diff > 0 Then Worksheets("Attuale").Range("J" & SqA + 4).Interior.ColorIndex = 43
        If Diff = 0 Then Worksheets("Attuale").Range("J" & SqA + 4).Interior.ColorIndex = 6
        End If
    Next SqA
Next SqP
End Sub
Private Sub ordinamento()
    Range("A4:J14").Select
    Selection.Sort Key1:=Range("B5"), Order1:=xlDescending, Key2:=Range("H5") _
        , Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
    Range("A1").Select
End Sub


L'odinamento prevede, come prima chiave, l'ordine decrescente colonna Punti e poi decrescente della colonna Diff.
Se non va bene così puoi sostituire la macro "Ordinamento" con quella in tuo possesso, l'importante è non cambiare il nome alla macro, se è necessario farlo, cambiare il nome anche alla chiamata (Call) della macro "Valuta".

Non è possibile, per il limitato spazio (altezza righe), inserire una freccia per ogni squadra, intesa come forma, eventualmente lo si può fare come simbolo (Font Simboli) come in questo file
(ho utilizzato la freccia grande come pulsante comando di avvio macro)


Fai sapere
Ciao
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: help formule e macro per programma fantacalcio

Postdi scirea1976 » 17/11/10 15:47

Anthony47 ha scritto:Mah... insomma vuoi la sostituzione della sostituzione?
In E15 del tuo foglio
Codice: Seleziona tutto
=SE(E(SOMMA(((E$3:E$13="-"))*(B$3:B$13=B15))>0;SOMMA(((E$3:E$13="-"))*(B$3:B$13=B15))>=SOMMA((B$15:B15=B15)*((D$15:D15<>"-"))));SE(E(D15<>"+-";SOMMA(--(LUNGHEZZA(E$14:E14)>0))<3);D15;"");"")
Ricorda Contr-Maiusc-Enter

Ciao


Anthony avevo cantato vittoria troppo presto, ho trovato un caso in cui la formula mi sbaglia il conteggio,
praticamente mi fa la sostituzione della sostituzione anche se la prima sostituzione a come voto ( 5 . 6 e cosi via.. ) invece dovrebbe farla solo se il voto è "-" nullo.
Ho postato 2 esempi .... nel secondo quello di destra la formula e perfetta ... invece nel primo sbaglia..
grazie per la pazienza... ;)


---------
La discussione di scirea1976 e' spostata qui: viewtopic.php?f=26&t=89060
Anthony
---------
scirea1976
Utente Junior
 
Post: 21
Iscritto il: 08/11/10 04:44

Re: help formule e macro per programma fantacalcio

Postdi scirea1976 » 17/11/10 15:51

chiedo scusa ai moderatori ma non ho postato l'esempio.... eccolo
http://www.realfanta2009.altervista.org/scirea.xls

P.S. non c'è un modo per modificare i topic una volta inseriti ???
scirea1976
Utente Junior
 
Post: 21
Iscritto il: 08/11/10 04:44

Re: help formule e macro per programma fantacalcio

Postdi gigilatrottola » 17/11/10 19:46

ciao flash e grazie per la macro, funziona benissimo, pero' ho sostituito il nome attuale con classifica.

l'unica cosa non riesco a scaricare il tuo file x vedere i simboli che hai messo dato che il risultato che ho ottenuto con i colori non era proprio il mio ideale,( ma sempre meglio di niente)

puoi rimettere il tuo file?
grazie e buona serata
gigilatrottola
Utente Senior
 
Post: 190
Iscritto il: 10/06/06 09:58

Re: help formule e macro per programma fantacalcio

Postdi Flash30005 » 17/11/10 20:18

Strano che non hai potuto scaricare il file, io l'ho appena fatto
guarda l'immagine, nella quale spiego come fare

Immagine


immagine intera



se non riesci prova con questo server

Ciao
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: help formule e macro per programma fantacalcio

Postdi gigilatrottola » 17/11/10 22:41

ok sono riuscito a scaricarlo, praticamente nn aspettavo il tempo dovuto.....
sono ignorante??? :D
bhe lasciamo stare....

ti devo dire 2 cose:
1- praticamente avevo fatto una cavolata, nel senso mi ero dimenticato di mettere nella colonna A le posizioni da 1 a 10, però modificando la tua macro sono riuscito ad adattarlo al mio file (se ci dai un'occhiata mi fai un piacere, ma mi sembra tutt'ok)
2 - giusto x essere pignoli, è possibile fare le due frecce ( quella di nessun guadagno in classifica) un giallo + forte x distinguerla da quella verde?
la rossa e la verde sono ok

ps logicamente se sono troppo rompiscatole lascia stare il colore delle frecce....già è tantissimo quello che stai facendo x me e .......


ecco il file:
http://rapidshare.com/files/431478639/e ... ifica3.xls


grazie ancora.......
gigilatrottola
Utente Senior
 
Post: 190
Iscritto il: 10/06/06 09:58

Re: help formule e macro per programma fantacalcio

Postdi Flash30005 » 18/11/10 00:21

Cosa intendi per più "forte"?

Se la vuoi piu giallo canarino usa il 27 (dove ti dirò)
oppure il 44 o il 45 (che hanno un po' più di rosso)

Il numero lo dovrai sostituire al valore-colore 6 esistente nella parte indicata all'interno della macro
Codice: Seleziona tutto
 
...
If Diff = 0 Then
                Worksheets("Attuale").Range("K" & SqA + 4).Value = "tu"
                Worksheets("Attuale").Range("K" & SqA + 4).Font.Name = "Wingdings 3"
                Worksheets("Attuale").Range("K" & SqA + 4).Font.Size = 12
                Worksheets("Attuale").Range("K" & SqA + 4).Font.ColorIndex = 6  '<<<< sostituisci questo valore
End If


Ciao
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: help formule e macro per programma fantacalcio

Postdi gigilatrottola » 18/11/10 11:39

grazie mille...perfetto.......

grazie a te ed anthony ho fatto un bel "programmino" per il mio fantacalcio........
ora come ciliegina sulla torta mi manca solo mettere una bella protezione sulle formule ed ho finito......
credo che sia una cosa semplice........


grazie ancora , siete stati disponibili e molto, molto pazienti.....

thank you!
gigilatrottola
Utente Senior
 
Post: 190
Iscritto il: 10/06/06 09:58

Re: help formule e macro per programma fantacalcio

Postdi gigilatrottola » 21/11/10 10:26

eccomi qua a dar fastidio di nuovo......
pensavo di aver risolto ma provando il file è uscito fuori un'altro problema :D

avevo fatto questa macro su foglio 1^ e logicamente funziona benissimo
facendo il copia e incolla sulle altre 35 giornate logicamente nn funziona alla meraviglia dato che non mi ordina le formazioni per T e poi 1 2 3 4 5 6 7..
la mia domanda è questa esiste qualche siglia o codice che mi permetta di far funzionare la macro anche sugli altri fogli oppure devo sostituire manualmente su tutti e 35 i fogli la scritta 1^ con le giornate rispettive (es. 2^ - 3^ - 4^ etc )?
grazie e buona domenica a tutti




Codice: Seleziona tutto
Sub ordinaeinvia()
'
' ordinaeinvia Macro
'

'
    Range("A2:C27").Select
    ActiveWorkbook.Worksheets("1^").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("1^").Sort.SortFields.Add Key:=Range("C3:C27"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "T,1 2 3 4 5 6 7", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("1^").Sort
        .SetRange Range("A2:C27")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("D2:F27").Select
    ActiveWorkbook.Worksheets("1^").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("1^").Sort.SortFields.Add Key:=Range("F3:F27"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "T,1 2 3 4 5 6 7", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("1^").Sort
        .SetRange Range("D2:F27")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("G2:I27").Select
    ActiveWorkbook.Worksheets("1^").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("1^").Sort.SortFields.Add Key:=Range("I3:I27"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "T,1 2 3 4 5 6 7", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("1^").Sort
        .SetRange Range("G2:I27")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("J2:L27").Select
    ActiveWorkbook.Worksheets("1^").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("1^").Sort.SortFields.Add Key:=Range("L3:L27"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "T,1 2 3 4 5 6 7", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("1^").Sort
        .SetRange Range("J2:L27")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("M2:O27").Select
    ActiveWorkbook.Worksheets("1^").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("1^").Sort.SortFields.Add Key:=Range("O3:O27"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "T,1 2 3 4 5 6 7", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("1^").Sort
        .SetRange Range("M2:O27")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.SmallScroll Down:=15
    Range("A35:C60").Select
    ActiveWorkbook.Worksheets("1^").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("1^").Sort.SortFields.Add Key:=Range("C36:C60"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "T,1 2 3 4 5 6 7", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("1^").Sort
        .SetRange Range("A35:C60")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("D35:F60").Select
    ActiveWorkbook.Worksheets("1^").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("1^").Sort.SortFields.Add Key:=Range("F36:F60"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "T,1 2 3 4 5 6 7", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("1^").Sort
        .SetRange Range("D35:F60")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("G35:I60").Select
    ActiveWorkbook.Worksheets("1^").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("1^").Sort.SortFields.Add Key:=Range("I36:I60"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "T,1 2 3 4 5 6 7", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("1^").Sort
        .SetRange Range("G35:I60")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("J35:L60").Select
    ActiveWorkbook.Worksheets("1^").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("1^").Sort.SortFields.Add Key:=Range("L36:L60"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "T,1 2 3 4 5 6 7", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("1^").Sort
        .SetRange Range("J35:L60")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("M35:O60").Select
    ActiveWorkbook.Worksheets("1^").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("1^").Sort.SortFields.Add Key:=Range("O36:O60"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "T,1 2 3 4 5 6 7", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("1^").Sort
        .SetRange Range("M35:O60")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.SmallScroll Down:=-33
    Range("A3:B15").Select
    Selection.Copy
    Range("A3:B13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("X4").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A14:B20").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("X18").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D3:E13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AC4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D14:E20").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AC18").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G3:H13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AH4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      Range("G14:H20").Select
    Application.CutCopyMode = False
    Selection.Copy
      Range("AH18").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     Range("J3:K13").Select
    Application.CutCopyMode = False
    Selection.Copy
      Range("AM4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("J14:K20").Select
    Application.CutCopyMode = False
    Selection.Copy
      Range("AM18").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     Range("M3:N13").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.LargeScroll ToRight:=1
    ActiveWindow.ScrollColumn = 39
    ActiveWindow.ScrollColumn = 38
    Range("AR4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.LargeScroll ToRight:=-1
    Range("M14:N20").Select
    Application.CutCopyMode = False
    Selection.Copy
       Range("AR18").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     ActiveWindow.SmallScroll Down:=15
    Range("A36:B46").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("X34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A47:B53").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("X48").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D36:E46").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AC34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D47:E53").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AC48").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G36:H46").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AH34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.ScrollColumn = 7
    Range("G47:H53").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AH48").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J36:K46").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AM34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     Range("J47:K53").Select
    Application.CutCopyMode = False
    Selection.Copy
      Range("AM48").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("M36:N46").Select
    Range("N36").Activate
    Application.CutCopyMode = False
    Selection.Copy
      Range("AR34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     Range("M47:N53").Select
    Application.CutCopyMode = False
    Selection.Copy
        Range("AR48").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       Range("Q21").Select
End Sub

Sub ordinaeinvia2()
'
' ordinaeinvia Macro
'

'
    Range("A2:C27").Select
    ActiveWorkbook.Worksheets("2^").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("2^").Sort.SortFields.Add Key:=Range("C3:C27"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "T,1 2 3 4 5 6 7", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("2^").Sort
        .SetRange Range("A2:C27")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("D2:F27").Select
    ActiveWorkbook.Worksheets("2^").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("2^").Sort.SortFields.Add Key:=Range("F3:F27"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "T,1 2 3 4 5 6 7", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("2^").Sort
        .SetRange Range("D2:F27")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("G2:I27").Select
    ActiveWorkbook.Worksheets("2^").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("2^").Sort.SortFields.Add Key:=Range("I3:I27"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "T,1 2 3 4 5 6 7", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("2^").Sort
        .SetRange Range("G2:I27")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("J2:L27").Select
    ActiveWorkbook.Worksheets("2^").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("2^").Sort.SortFields.Add Key:=Range("L3:L27"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "T,1 2 3 4 5 6 7", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("2^").Sort
        .SetRange Range("J2:L27")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("M2:O27").Select
    ActiveWorkbook.Worksheets("2^").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("2^").Sort.SortFields.Add Key:=Range("O3:O27"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "T,1 2 3 4 5 6 7", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("2^").Sort
        .SetRange Range("M2:O27")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.SmallScroll Down:=15
    Range("A35:C60").Select
    ActiveWorkbook.Worksheets("2^").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("2^").Sort.SortFields.Add Key:=Range("C36:C60"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "T,1 2 3 4 5 6 7", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("2^").Sort
        .SetRange Range("A35:C60")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("D35:F60").Select
    ActiveWorkbook.Worksheets("2^").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("2^").Sort.SortFields.Add Key:=Range("F36:F60"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "T,1 2 3 4 5 6 7", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("2^").Sort
        .SetRange Range("D35:F60")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("G35:I60").Select
    ActiveWorkbook.Worksheets("2^").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("2^").Sort.SortFields.Add Key:=Range("I36:I60"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "T,1 2 3 4 5 6 7", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("2^").Sort
        .SetRange Range("G35:I60")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("J35:L60").Select
    ActiveWorkbook.Worksheets("2^").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("2^").Sort.SortFields.Add Key:=Range("L36:L60"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "T,1 2 3 4 5 6 7", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("2^").Sort
        .SetRange Range("J35:L60")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("M35:O60").Select
    ActiveWorkbook.Worksheets("2^").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("2^").Sort.SortFields.Add Key:=Range("O36:O60"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "T,1 2 3 4 5 6 7", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("2^").Sort
        .SetRange Range("M35:O60")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.SmallScroll Down:=-33
    Range("A3:B15").Select
    Selection.Copy
    Range("A3:B13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("X4").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A14:B20").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("X18").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D3:E13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AC4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D14:E20").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AC18").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G3:H13").Select
    Application.CutCopyMode = False
    Selection.Copy
     Range("AH4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      Range("G14:H20").Select
    Application.CutCopyMode = False
    Selection.Copy
      Range("AH18").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J3:K13").Select
    Application.CutCopyMode = False
    Selection.Copy
       Range("AM4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       Range("J14:K20").Select
    Application.CutCopyMode = False
    Selection.Copy
       Range("AM18").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       Range("M3:N13").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.LargeScroll ToRight:=1
    ActiveWindow.ScrollColumn = 39
    ActiveWindow.ScrollColumn = 38
    Range("AR4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.LargeScroll ToRight:=-1
    Range("M14:N20").Select
    Application.CutCopyMode = False
    Selection.Copy
      Range("AR18").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     Range("A36:B46").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("X34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A47:B53").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("X48").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D36:E46").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AC34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D47:E53").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AC48").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G36:H46").Select
    Application.CutCopyMode = False
    Selection.Copy
        Range("AH34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.ScrollColumn = 7
    Range("G47:H53").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AH48").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J36:K46").Select
    Application.CutCopyMode = False
    Selection.Copy
        Range("AM34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      Range("J47:K53").Select
    Application.CutCopyMode = False
    Selection.Copy
      Range("AM48").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       Range("M36:N46").Select
    Range("N36").Activate
    Application.CutCopyMode = False
    Selection.Copy
      Range("AR34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       Range("M47:N53").Select
    Application.CutCopyMode = False
    Selection.Copy
     Range("AR48").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      Application.CutCopyMode = False
      Range("Q21").Select
End Sub
gigilatrottola
Utente Senior
 
Post: 190
Iscritto il: 10/06/06 09:58

PrecedenteProssimo

Torna a Applicazioni Office Windows


Topic correlati a "help formule e macro per programma fantacalcio":


Chi c’è in linea

Visitano il forum: Nessuno e 54 ospiti