Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

[ RESOLU ] Modifier une macro,qui suppriment des plage...

Guido

XLDnaute Accro
Bonjour Le Forum

J'ai anouveau besoin de Vous

Dans mon fichier pour les courses de chx,une macro suppriment des plages et efface les données

de la veille,pour mettre en place les nouvelles

Voici le VBA

Sub RemplirTrios()
Dim t$, f As Worksheet, nf%, n, a(), i, course$, lig, h&, R As Range, j%, li&
t = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each f In Worksheets
If f.Name Like "Trio R*" Then
nf = nf + 1
f.[C1,B3:N22,S3:X3,AB3:AC22,S18:T18,S11:U11,AG3:AH22,AL3:AQ3,AL19:AN20] = "" 'RAZ
f.[S3:X3,AB3:AC22,AK12,AN12,AK16,AN16,S11:U11,AL3:AQ3,AL20:AN20,AK12,AK16,AN12,AN16] = 0
f.Rows("23:" & f.Rows.Count).Delete 'suppression des tableaux suivants
With Feuil2
'---liste des courses et adresse de la zone source---
n = 0: Erase a
For i = 1 To maxcourse
course = "Course: R." & Mid(f.Name, 7) & "-C." & i
lig = Application.Match(course & "*", .[B:B], 0)
If IsNumeric(lig) Then
n = n + 1
ReDim Preserve a(1 To 2, 1 To n)
h = Application.Match("Rang*", .Cells(lig + 9, 2).Resize(20), 0)
a(1, n) = Replace(Replace(Replace(course, "Course: ", ""), "-", ""), ".", "")
a(2, n) = lig + 5 & ":" & lig + h + 7
End If
Next i
If n Then
'---création des n tableaux (vides)---
For i = 2 To n
f.Rows("1:22").Copy f.Cells(1 + 23 * (i - 1), 1) '1 ligne de séparation
Next i
'---remplissage des n tableaux
For i = 1 To n
lig = 1 + 23 * (i - 1)
Set R = .Range(a(2, i)): h = R.Rows.Count 'a(1,i)= course a(2,i) ligne de 20:28
'---Course---
f.Cells(lig, 3) = a(1, i)
lig = lig + 2
'---Matin---
f.Cells(lig, 3).Resize(h) = R.Columns(5).Value
'---Tot2---
f.Cells(lig, 4).Resize(h) = R.Columns(16).Value
'---A3P---
f.Cells(lig, 5).Resize(h) = R.Columns(17).Value
'---Fit1---
f.Cells(lig, 6).Resize(h) = R.Columns(9).Value
'---Fit2---
f.Cells(lig, 7).Resize(h) = R.Columns(10).Value
'---V"L---
f.Cells(lig, 8).Resize(h) = R.Columns(29).Value
'---N°---
f.Cells(lig, 2).Resize(h) = R.Columns(2).Value
aa = f.Cells(lig, 1).Resize(h, 5)
Call ClasserA3P
f.Cells(lig, 11).Resize(UBound(bb), 1) = bb
f.Cells(lig, 1).Resize(h, 14).Sort f.Columns(6), xlDescending, Header:=xlNo
aa = f.Cells(lig, 1).Resize(h, 14)
Call ClasserFit1
f.Cells(lig, 12).Resize(UBound(bb), 1) = bb
f.Cells(lig, 1).Resize(h, 14).Sort f.Columns(7), xlDescending, Header:=xlNo
aa = f.Cells(lig, 1).Resize(h, 7)
Call ClasserFit2
f.Cells(lig, 13).Resize(UBound(bb), 1) = bb
f.Cells(lig, 1).Resize(h, 14).Sort f.Columns(8), xlAscending, Header:=xlNo
aa = f.Cells(lig, 1).Resize(h, 8)
Call ClasserVL
f.Cells(lig, 14).Resize(UBound(bb), 1) = bb
f.Cells(lig, 1).Resize(h, 14).Sort f.Columns(4), xlDescending, Header:=xlNo
aa = f.Cells(lig, 1).Resize(h, 10)
Call ClasserTot2
f.Cells(lig, 10).Resize(UBound(bb), 1) = bb
li = Split(a(2, i), ":")(1)
aa = .Range(.Cells(li + 8, 19), .Cells(li + 10, 23))
Call Extraire
f.Cells(lig, 38).Resize(1, UBound(bb, 2)) = bb
f.Cells(lig, 1).Resize(h, 14).Sort f.Columns(1), xlAscending, Header:=xlNo
f.Cells(lig, 16).Resize(h).Calculate 'recalcul des formules en colonne P
f.Cells(lig, 15).Resize(h).Calculate 'recalcul des formules en colonne O
f.Cells(lig, 1).Resize(h, 16).Sort f.Columns(16), xlDescending, Header:=xlNo
'---remplissage PRN---
j = Application.CountIf(f.Cells(lig, 16).Resize(h), ">0")
If j > 6 Then j = 6
If j Then f.Cells(lig, 19).Resize(, j) = Application.Transpose(f.Cells(lig, 2).Resize(j))
aa = f.Cells(lig, 15).Resize(h, 2)
f.Cells(lig, 28).Resize(UBound(aa), 2) = aa
f.Cells(lig, 1).Resize(h, 16).Sort f.Columns(1), xlAscending, Header:=xlNo
Next i
End If
End With
End If
Next f
Application.Calculation = xlCalculationAutomatic
Call ClasserPoint
Application.ScreenUpdating = True
MsgBox "Remplissage des " & nf & " feuilles Trios en " & Format(Timer - t, "0.00s")
End Sub


Merci pour votre aide

Guido
 

Staple1600

XLDnaute Barbatruc
Bonsoir à tous

Guido
Petite piqûre de rappel
(extrait de la charte du forum)
2 – Tous les membres du forum répondent gracieusement aux questions. Il n’y a donc aucune obligation de résultat et de délai. Les mots URGENT, SOS, AU SECOURS sont donc à bannir.
On n'est pas aux pièces.
Nous sommes en week-end
Week-end ou en plus se déroulent les journées du Patrimoine sans oublier la Coupe Davis.
Donc un peu de patience, non ?
 

Guido

XLDnaute Accro
Bonsoir le Forum

toujours pas une piste,,???

Merci d'avance

Guido

Re

Si parfois j'oublie un fichier. exprime mal une demande ou change le but de ma demande et que je reçois

une petite réprimande .. La OK.

Je suis surpris par ta reaction.car apres avoir poster plus de 1100 demandes ou reponses,je n'ai JAMAIS

ecrit les MOTS NI URGENT,NI SOS, NI AU SECOURS,NI REPROCHER UN MANQUE DE REPONSE

sur mes post. Je tourne la page.

Bon Dimanche

Merci

Guido
 

Guido

XLDnaute Accro
Bonjour Le Forum

Je me cite..

J'ai a nouveau besoin de Vous

Dans mon fichier pour les courses de chx,une macro suppriment des plages et efface les données

de la veille,pour mettre en place les nouvelles


Je me rend compte que ma demande manque de précision . je m'Excuse

Donc..

Dans mon fichier pour les courses de chx,une macro suppriment des plages et efface les données

de la veille, pour mettre en place les nouvelles données.

J'aimerais que la macros suppriment uniquement les données et pas les tableaux..


Je vais faire afficher en jaune ce qu'il faudrait effacé.

Merci

Guido
 

Pièces jointes

  • Prono 2017-AVEC SUPER BASE-V2.xls
    2.5 MB · Affichages: 107

Staple1600

XLDnaute Barbatruc
Bonjour à tous

Guido
Il manque encore un chouia de précisions
Dans mon fichier pour les courses de chx,une macro suppriment des plages et efface les données
de la veille, pour mettre en place les nouvelles données.
Quelle macro? Quel est son nom? Elle se situe dans quel module ?
C'est bien celle de ton premier message ?

Et pour ceci:
J'aimerais que la macros suppriment uniquement les données et pas les tableaux..

tu as déjà une ligne de code pour dans ton classeur qui réponds à ta question
Range(.Cells(lig + 16, 38), .Cells(lig + 17, 40)).ClearContents
ClearContents ne supprime que les données

PS: Nous sommes toujours en week-end et les mots que j'ai précédemment mis en gras dans mon précédent mesage sont seulement ceux-ci
Il n’y a donc aucune obligation de résultat et de délai.
 

Guido

XLDnaute Accro

Bonjour

Merci pour ta demande de précision

Quelle macro? Bouton Remplir les feuilles Trio...

Quel est son nom? RemplirTrios

Elle se situe dans quel module ? Je ne sais pas,car ce n'est pas moi qui a fait les macros

J'aimerais que la macros suppriment uniquement les données

et
pas les tableaux..


Quelle est la macros qui suppriment les Tableaux ???SVP

Merci as plus

Guido

 

Staple1600

XLDnaute Barbatruc
Re

Guido
Pour supprimer les données, voir la fin de mon précédent message ?
Où il est question de ClearContents

Testes cette macro sur une copie de ton fichier
VB:
Sub Test()
ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants, 23).Select
MsgBox Selection.Count & " cellules avec des données.", vbInformation, "Comptage cellules à effacer"
Selection.ClearContents
End Sub
Seules les cellules avec formules sont conservées, les tableaux ne sont pas supprimés mais on a comme un léger problème, non ?
 
Dernière édition:

Guido

XLDnaute Accro
Re

Merci pour ta réponse.

Comme dis plus haut je ne sais pas faire les nouvelles Macros.

je sais modifier une macros déjà présente seulement.

mais la ??? je doit crées une nouvelle avec un nouveau boutons ??? c'est ca..

merci

Guido
 

Staple1600

XLDnaute Barbatruc
Re

Guido
Comme dis plus haut je ne sais pas faire les nouvelles Macros.
?
Quand on se sait pas faire, on apprend à faire, non ?
Il y a suffisamment d'exemples sur le forum, de tutoriels sur le net pour savoir comment on exécute une macro, non ?

En l’occurrence, si tu as bien lu mon précédent message, il s'agit juste d'une macro de test à tester sur une copie de ton fichier (pour éviter la perte de données)
Est-ce que tu as fait ce test ?
(Petit rappel : ALT+F11 - >Aller dans le menu Insertion et choisir Insérer un module
puis y copier/coller la macro du message#10 et appuyez sur F5 et enfin sur ALT+Q pour revenir dans Excel)


Que constates-tu alors ?
 

Guido

XLDnaute Accro
 

job75

XLDnaute Barbatruc
Bonjour Guido, Jean-Marie,
Dans mon fichier pour les courses de chx,une macro suppriment des plages et efface les données

de la veille, pour mettre en place les nouvelles données.


J'aimerais que la macros suppriment uniquement les données et pas les tableaux.
Je suis très étonné par ce fil et par cette question.

A l'origine c'est moi qui vous ai donné, en juin dernier, la macro "RemplirTrios" mais vous l'avez transformée, en particulier pour ce qui concerne les classements (il y avait une macro paramétrable pour les faire).

J'espère que vous savez ce que vous avez fait et je considère donc que je n'en suis plus responsable.

J'en rappelle pourtant le principe :

- dans chaque feuille "Trio" les tableaux sont supprimés à partir du 2ème : c'est tout à fait normal et nécessaire puisque le nombre de courses peut être différent d'une journée à l'autre

- le 1er tableau est conservé et les plages répertoriées (sans formules) sont vidées

- ce 1er tableau (vide) est copié vers le bas autant de fois qu'il y a de courses

- tous les tableaux sont ensuite remplis avec les données de la feuille "Prono".

Votre question n'a donc aucun sens.

A+
 
Dernière édition:

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…