salve a tutti ed auguri......
eccomi qua di nuovo a dar fastidio, ma credo che sia una cosa semplice, semplice
questo è il file:
http://rapidshare.com/files/440824251/e ... quadre.xlsquesta è la macro adatta ad una classifica a 10 squadre mentre ora mi occorrerebbe che funzionasse su di una classifica a 12 squadre.....
qualcosa sono riuscito a cambiare ma credo che sbagli nella prima parte......
cortesemente mi potete aiutare?
- Codice: Seleziona tutto
Sub ordinaclassifica()
Worksheets("classifica").Range("K5:K16").ClearContents
For RR = 5 To 14
VettSqP(RR - 4) = Worksheets("classifica").Range("B" & 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("classifica").Range("B" & 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("classifica").Range("K" & SqA + 4).Value = "q"
Worksheets("classifica").Range("K" & SqA + 4).Font.Name = "Wingdings 3"
Worksheets("classifica").Range("K" & SqA + 4).Font.Size = 12
Worksheets("classifica").Range("K" & SqA + 4).Font.ColorIndex = 3
End If
If Diff > 0 Then
Worksheets("classifica").Range("K" & SqA + 4).Value = "p"
Worksheets("classifica").Range("K" & SqA + 4).Font.Name = "Wingdings 3"
Worksheets("classifica").Range("K" & SqA + 4).Font.Size = 12
Worksheets("classifica").Range("K" & SqA + 4).Font.ColorIndex = 10
End If
If Diff = 0 Then
Worksheets("classifica").Range("K" & SqA + 4).Value = "="
Worksheets("classifica").Range("K" & SqA + 4).Font.Name = "Copperplate Gothic Light"
Worksheets("classifica").Range("K" & SqA + 4).Font.Size = 12
Worksheets("classifica").Range("K" & SqA + 4).Font.ColorIndex = 6
End If
End If
Next SqA
Next SqP
End Sub
Private Sub ordinamento()
Range("B4:K16").Select
Selection.Sort Key1:=Range("C5"), Order1:=xlDescending, Key2:=Range("I5") _
, Order2:=xlDescending, Key3:=Range("G5"), Order3:=xlDescending, Header _
:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
Range("J18").Select
End Sub
grazie a tutti e buona serata