Des bugs quand je veux partir d'une feuille quasi-vierge de résultats
Bonsoir,
Je voudrais partir d'une feuille quasi-vierge de résultats et un premier bug arrive dans le module13, macro Medailles :
Sub Medailles()
Dim Dict, i1, i2, i3, i4, sSexe, i As Integer, iOffset, Pts, N
Set Dict = CreateObject("scripting.dictionary")
iOffset = Range("tabel1").Row - 1
For i1 = 1 To 3
Select Case i1
Case 1
f_ = "MOD(IFERROR(AGGREGATE(15,6,(Tabel1[CLT1]+ROW(Tabel1[CLT1])/1000)/(Tabel1[Sexe]=#),@),0),1)*1000"
Set c = Range("tabel1[pts_1]")
Case 2
f_ = "MOD(IFERROR(AGGREGATE(15,6,(Tabel1[CLT2]+ROW(Tabel1[CLT2])/1000)/(Tabel1[Sexe]=#),@),0),1)*1000"
Set c = Range("tabel1[pts_2]")
Case 3
f_ = "MOD(IFERROR(AGGREGATE(15,6,(Tabel1[CLT3]+ROW(Tabel1[CLT3])/1000)/(Tabel1[Sexe]=#),@),0),1)*1000"
Set c = Range("tabel1[pts_3]")
End Select
For i2 = 1 To 2
sSexe = IIf(i2 = 1, "H", "F")
For i3 = 1 To 100
s = Replace(Replace(f_, "#", Chr(34) & sSexe & Chr(34)), "@", i3)
i4 = Evaluate(s)
If i4 = 0 Then Exit For
i = i4 - iOffset
Pts = c.Cells(i, 1).Value2
If Pts > 0 And Len(Pts) > 0 Then
'Debug.Print Pts
If Not Dict.exists(i) Then Dict(i) = Array(i4, Range("Tabel1[nom]").Cells(i, 1).Value2, Range("Tabel1[prenom]").Cells(i, 1).Value2, Range("Tabel1[sexe]").Cells(i, 1).Value2, Range("Tabel1[age]").Cells(i, 1).Value2, 0, 0, 0, 0)
'Debug.Print i, Range("Tabel1[nom]").Cells(i, 1).Value2, Range("Tabel1[prenom]").Cells(i, 1).Value2, Range("Tabel1[sexe]").Cells(i, 1).Value2, Range("Tabel1[age]").Cells(i, 1).Value2, 0, 0, 0, 0
itm = Dict(i)
itm(5) = Application.Max(Pts, itm(5)) 'itm(5) = Pts
If i1 = 1 Then itm(6) = Application.Max(Pts, itm(6))
If i1 = 2 Then itm(7) = Application.Max(Pts, itm(7)) 'itm(7) = IIf(i1 = 2, Pts, 0)
If i1 = 3 Then itm(8) = Application.Max(Pts, itm(8)) 'itm(8) = IIf(i1 = 3, Pts, 0)
Dict(i) = itm
End If
Next
Next
Next
N = Dict.Count
If N = 1 Then Dict.Add "dummy", Dict.items()(0)
b = Application.EnableEvents 'état des évenements (false ou true)
Application.EnableEvents = False 'désactiver
With Range("tabel6").ListObject
.Parent.Protect "seb", userinterfaceonly:=True 'enlever la protection pour la feuille pour VBA **********
If N = 0 And .ListRows.Count > 0 Then .DataBodyRange.Delete: Exit Sub
If .ListRows.Count = 0 Then .ListRows.Add
.DataBodyRange.Resize(Dict.Count, 9).Value = Application.Index(Dict.items, 0, 0)
If .ListRows.Count > N Then .DataBodyRange.Offset(N).Resize(.ListRows.Count - N).Delete
With .Range
.Sort .Cells(1, 4), xlAscending, , .Cells(1, 6), xlDescending, Header:=xlYes
End With
End With
Application.EnableEvents = b 'remettre dans l'état de 10 lignes plus haut
End SubPeut-être faut-il que je laisse davantage de lignes vides que les 3 que j'ai laissées ?
Merci
Bonne soirée
plan B de cet après-midi
with range("....").listobject
.parent.unprotect "seb" (au lieu de ce protect avec userinterfaceonly)
......... (reste entre les parenthèses)
.parent.protect "seb"
end with
Bonjour Bart' et merci beaucoup, encore & encore
J'ai peut-être mal placé le "Protect" ? Je le déplace un cran en dessous ?
Sinon, j'ai un curieux souci sur la colonne "Date Anniv." car parfois, le format ne prend pas ==> G tapé "020289" et ça sort 19/07/55.
Sur la première ligne, c'est sorti comme il faut (01/01/01)
J'ai vérifié le format et le code VBA sans pouvoir déceler le pb
En fait ça ne marche correctement que si je ne débloque pas dans "Débloquer ou Quitter". Ca veut dire que la macro se désactive ?
Case 99
b = (10100 <= nouvelle And nouvelle < 311299) 'valeur entre 1 janvier 1945 et 31 décembre 2015
If b Then
Temp = Format(--Right("0" & nouvelle, 6), "00\/00\/00") 'éventuellement ajouter un préfix "0", puis bon format et splitter
sp = Split(Temp, "/")
temp1 = CLng(DateSerial(sp(2), sp(1), sp(0)))
b = (StrComp(Format(temp1, "dd/mm/yy"), Temp, 1) = 0) 'convertir valeur en "ss.00"
If b Then
If 1945 > Year(temp1) Or Year(temp1) > 2010 Then MsgBox "année n'est pas correcte", vbExclamation, Year(temp1): GoTo DEFAIRE
End If
End If
If Not b Then
MsgBox "valeur douteuse", vbCritical, Temp
GoTo DEFAIRE 'ignorer modification et reculer vers situation précédente
Else
nouvelle = temp1
End IfEncore merci Bart'
Bonne journée...
à+
Salut Vodoraix
Punaise, la base, sérieux !
Le point dans une instruction, pointe sur l'objet avec le With qui le précède
Donc OUI ton "Protect" est mal placé
bonjour vodoraix, salut JExceL2Fr
bon, 2ième problème pour la date, c'est que, un moment donné, les évenements sont bloqués (on a eu un "application.enableevents=false" sans le restorer avec un "=true") et donc quand tu tape "020289", excel comprend cela comme le chiffre 20.289 et "19/07/55" et le 20.289ième jour depuis le1/1/1900. Donc c'est logique et si tu modifies quelque chose en VBA et après vous voulez le fonctionnement normal, je crois que tu dois activer tout avec le bouton "réinitialisation" (macro "Enlever_Protection_Et_Events").
puis premier problème, j'ai récris un peu la partie entre ce "With ... End With" de manière que quand les evenements sont bloqués et la protection est enlevée, qu'après le "End With" les 2 y sont de nouveau mis en place.
@JExceL2Fr, concernant ce point en combinaison avec le "With" d'un Listobject, son parent est la feuille et donc .parent.protect "seb" met bien la protection sur la feuille
Hello Bart' et merci beaucoup
L'explication des dates et le coup de 1900 est magistral..
Et mille excuses, j'avais complètement oublié le bouton "réinitialisation" et son utilité !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Tout marche bien
Impressionnantes, tes connaissances !!!! Bill Gates a raté une embauche de qualité !!!!
Je suis en train de revoir le VBA pour les RAZ et & importations des noms sur les feuilles de pétanques car ça ne se fait pas correctement... J'ai espoir d'y arriver...
Encore mille mercis mon champion
Bonne soirée