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

Macro mal écrite

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion Fabien
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
F

Fabien

Guest
Bonjour
Est ce que quelqu'un peut m'aider à mieux l'écrire, car quand je m'en sert mon fichier augmente en taille d'une facon importante
Merci

Sub SupprimeJoueur()
'déprotéger feuille
With ActiveSheet
.EnableSelection = xlNoRestrictions
.Unprotect Password:="Milou"
'positionner en fin de tableau
Cells.Find(What:="FinTab", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False).Activate
'sélection des deux lignes au dessus et efface
ActiveCell.Offset(-2, 0).Rows("1:2").EntireRow.Select
Selection.Delete Shift:=xlUp
'positionner en fin de tableau
Cells.Find(What:="FinTab", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False).Activate
'sélection de la zone pour refaire les bordures
ActiveCell.Offset(-2, 0).Range("C1:W1,Y1:Z1,AB1:AC1").Select
'Bordures
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
'positionner de la fin du demi tableau
Cells.Find(What:="FinDTab", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False).Activate
'sélection des deux lignes au dessus et efface
ActiveCell.Offset(-2, 0).Rows("1:2").EntireRow.Select
Selection.Delete Shift:=xlUp
'positionner de la fin du demi tableau
Cells.Find(What:="FinDTab", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False).Activate
'sélection de la zone pour refaire les bordures
ActiveCell.Offset(-2, 0).Range("C1:W1,Y1:Z1,AB1:AC1").Select
'Bordures
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
'positionner de la fin de tableau
Cells.Find(What:="FinTab", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False).Activate
'Sélection de toutes les lignes sauf les 4 qui suivent mon repère
ActiveCell.Offset(4, 0).Rows("1:65536").EntireRow.Select
Selection.EntireRow.Hidden = True
'Protège feuille
.EnableSelection = xlNoSelection
.Protect Password:="Milou", Contents:=True, UserInterfaceOnly:=True, Scenarios:=True
End With

End Sub

PS Rows("1:65536") fait planter ma macro, comment finou derniere au lieu 65536

Merci
 
Trier par date Trier par votes
Salut,

Essai ceci:

1-sélectionne tout ton code
2-Ctrl + C (Copier)
3-Suppr
4-Ctrl + V (Coller)
5-enregistre
6-Regarde la taille
7-Réponds-moi pour me dire ce qu'il en est

@+
 
Vote positif 0 Vote négatif
Salut!

On voit que t'as appris le VBA avec l'enregistreur de macro!
Cependant il a une fâcheuse tendance à beaucoupo alourdir le code pour du vent!

J'ai éclairecis du mieux que j'ai pu, je l'ai pas testé mais j'espère que t'aura compris le principe qui dit :
Supprime les "Select", "Activate", et autres "Selection" autant que tu le peux (sauf si tu veux vraiment selectionner un objet)
Sub SupprimeJoueur() et utilise des variables.

Dim cellule as Range
dim plage as Range

'déprotéger feuille
With ActiveSheet
.EnableSelection = xlNoRestrictions
.Unprotect Password:="Milou"
'positionner en fin de tableau
Set cellule=Cells.Find(What:="FinTab", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False)
'sélection des deux lignes au dessus et efface
cellule.Offset(-2, 0).Rows("1:2").EntireRow.Delete Shift:=xlUp
'positionner en fin de tableau
Set cellule=Cells.Find(What:="FinTab", After:=cellule, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False)
'sélection de la zone pour refaire les bordures
Set plage=cellule.Offset(-2, 0).Range("C1:W1,Y1:Z1,AB1:AC1")
With plage
'Bordures
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With
'positionner de la fin du demi tableau
Set cellule=Cells.Find(What:="FinDTab", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False)
'sélection des deux lignes au dessus et efface
Set plage=cellule.Offset(-2, 0).Rows("1:2").EntireRow.Delete Shift:=xlUp
'positionner de la fin du demi tableau
Set cellule=Cells.Find(What:="FinDTab", After:=cellule, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False)
'sélection de la zone pour refaire les bordures
Set plage=cellule.Offset(-2, 0).Range("C1:W1,Y1:Z1,AB1:AC1")
'Bordures
With plage
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With
'positionner de la fin de tableau
Set cellule=Cells.Find(What:="FinTab", After:=cellule, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False)
'Sélection de toutes les lignes sauf les 4 qui suivent mon repère
cellule.Offset(4, 0).Rows("1:65536").EntireRow
cellule.EntireRow.Hidden = True
'Protège feuille
.EnableSelection = xlNoSelection
.Protect Password:="Milou", Contents:=True, UserInterfaceOnly:=True, Scenarios:=True
End With

End Sub


Bonne chance
 
Vote positif 0 Vote négatif
Merci fodjio

mais ta macro ne fonctionne pas
sinon je pense avoir cibler ce qui augmente la taille de mon fichier,c'est la fonction qui masque les lignes, je pense???

cellule.Offset(4, 0).Rows("1:65536").EntireRow
cellule.EntireRow.Hidden = True

Peut on écrire 65536 autrement

Merci A+
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

A
  • Question Question
XL 2010 Filtrer un Combobox en VBA excel
2 3
Réponses
43
Affichages
2 K
Dranreb
F
  • Question Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
546
Francky79
F
D
  • Résolu(e)
Microsoft 365 Problème interférences entre macros
Réponses
14
Affichages
473
Phil69970
R
  • Question Question
XL 2016 Rendre plus lisible un code VBA
2
Réponses
23
Affichages
2 K
TooFatBoy
A
  • Question Question
Microsoft 365 Macro pour récupérer des colonnes qui ne sont pas conjointes
Réponses
4
Affichages
419
Anthony_51
A
K
  • Question Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
947
Kevin38
K
F
  • Résolu(e)
Microsoft 365 Commentaire cellule dans TextBox dans UserForm
Réponses
4
Affichages
699
Francky79
F
  • Question Question
XL 2016 Définir un nom en vba
Réponses
3
Affichages
568
Phillip
  • Question Question
XL 2016 excel VBA : recherche dans une colonne sans la sélectionner
Réponses
4
Affichages
571
job75
Y
  • Résolu(e)
XL 2013 Recherche qui fonctionne avec le texte et non la Value
Réponses
3
Affichages
530
youguybass
Y
  • Résolu(e)
XL 2016 Changer de feuille dans une macro
2
Réponses
28
Affichages
3 K
Staple1600
C
  • Résolu(e)
XL pour MAC Recherche Date
Réponses
12
Affichages
906
Phil69970
  • Résolu(e)
XL 2019 [Résolu] Problème VBA Find
Réponses
6
Affichages
2 K
lebarbo
C
  • Question Question
Microsoft 365 Macro tri des lignes
Réponses
5
Affichages
1 K
Chris Linefield
C
T
  • Question Question
XL pour MAC Recherche date
Réponses
5
Affichages
2 K
tdenis
T
D
  • Résolu(e)
XL 2016 VBA Problème avec les bordures intérieures
Réponses
2
Affichages
2 K
danielco
D
M
  • Question Question
XL 2010 code VBA pour trier une colonne de mon tableau
Réponses
8
Affichages
2 K
Michelrib
M
  • Question Question
Microsoft 365 Find : si texte recherché n'existe pas alors .....
Réponses
6
Affichages
1 K
laurent950
  • Résolu(e)
Microsoft 365 MsgBox en 2 temps
Réponses
2
Affichages
954
Usine à gaz
D
  • Question Question
Microsoft 365 Modification d'un code VBA
Réponses
8
Affichages
1 K
Hasco
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…