jacky49
XLDnaute Impliqué
bonsoir le forum,
Voici un fichier que j'ai récupéré sur le forum dont la macro a été faite par Gruick mais qui me pose un petit souci.(même 2).Un dans la macro et l'autre au niveau du somprod.
J'explique, j'ai voulu mettre une formule en colonne J pour eviter à avoir a retaper 2 fois le score ex: en J3=I4 et J4=I3 mais quand je fais le tirage, cela m'efface les formules car dans la macro, cela range le tirage aléatoire et efface les cellules,j'ai donc essayé de ne pas faire effacer les colonnes ou je mets les formules mais sans y parvenir.Donc si quelqu'un avait une idée,ce serait sympa et mon 2ème souci est que j'ai voulu mettre cette formule en colonne J: ex: en J3: =si(I4="";"";I4) mais la fonction somprod qui est en colonne C ne fonctionne plus.
merci de l'aide que vous pourrez m'apporter.
Voici le code ou se situe l'effaccement.
Voici un fichier que j'ai récupéré sur le forum dont la macro a été faite par Gruick mais qui me pose un petit souci.(même 2).Un dans la macro et l'autre au niveau du somprod.
J'explique, j'ai voulu mettre une formule en colonne J pour eviter à avoir a retaper 2 fois le score ex: en J3=I4 et J4=I3 mais quand je fais le tirage, cela m'efface les formules car dans la macro, cela range le tirage aléatoire et efface les cellules,j'ai donc essayé de ne pas faire effacer les colonnes ou je mets les formules mais sans y parvenir.Donc si quelqu'un avait une idée,ce serait sympa et mon 2ème souci est que j'ai voulu mettre cette formule en colonne J: ex: en J3: =si(I4="";"";I4) mais la fonction somprod qui est en colonne C ne fonctionne plus.
merci de l'aide que vous pourrez m'apporter.
Voici le code ou se situe l'effaccement.
Code:
Sub Tirage5()
' Tirage5 Macro
' Macro enregistrée le 21/04/06 par Gruick
' Touche de raccourci du clavier: Option+Cmd+r
Application.ScreenUpdating = False
With Application
.Calculation = xlManual
End With
z = Range("A65536").End(xlUp).Row
If z Mod 2 = 1 Then 'Si nb de joueurs est impair
z = z + 1
Cells(z, 1) = "xxxxxxxx" 'Joueur fantôme
End If
ReDim Preserve TTirage(z)
'Effacements et initialisations
[COLOR="Red"]Range("F3:AI46" & z).ClearContents[/COLOR]
d = "" 'd est la variable qui mémorise le match proposé
For i = 8 To 4 * 4 + 8 Step 4 'Compteur de partie
For a = 3 To z 'Compteur de noms
re:
Randomize
t = Int((z * Rnd) + 1)
If t <= 2 Then GoTo re
TTirage(a) = Cells(t, 1).Value
If a > 3 Then 'Nom déjà tiré précédemment ?
For tt = 3 To a - 1
If TTirage(a) = TTirage(tt) Then GoTo re
Next tt
End If
If a Mod 2 = 0 Then 'Mise en ordre alpha
If TTirage(a) < TTirage(a - 1) Then
prem = TTirage(a)
TTirage(a) = TTirage(a - 1)
TTirage(a - 1) = prem
End If
y = y + 1 'Proposition du match
ReDim Preserve TDoublons(y + 1)
TDoublons(y + 1) = TTirage(a - 1) & "/" & TTirage(a)
If TDoublons(y + 1) = d Then 'Comparaison avec l'avant dernier match,
'si le même, bloquage donc recommencer tout le tirage de la partie
For td = (y + 1) - (a - 3) / 2 To y + 1
TDoublons(td) = ""
Next td
a = 2
GoTo re
End If
If y > 2 Then 'Match déja tiré ? (Doublon de match)
For td = 2 To y
If TDoublons(y + 1) = TDoublons(td) Then
d = TDoublons(y + 1) 'd mémorise ce match
TDoublons(y + 1) = ""
TTirage(a) = ""
TTirage(a - 1) = ""
a = a - 1
GoTo re 'recommencer le tirage du match, donc du dernier adversaire
End If
Next td
End If
End If
Next a 'Nom suivant
For r = 3 To z
Cells(r, i) = TTirage(r)
Next r
Cells(3, i + 3).FormulaR1C1 = "=IF(RC[-2]>RC[-1],1,0)"
Cells(3, i + 3).Copy
Range(Cells(4, i + 3), Cells(z, i + 3)).PasteSpecial Paste:=xlFormulas
Next i 'Partie suivante
Application.ScreenUpdating = True
Range("A1").Select
With Application
.Calculation = xlAutomatic
End With
End Sub
" & z), Range("S3:T" & z), Range("W3:X" & z))
