Macro Excel:difficulté parcours d'un tableau
Fermé
benours
Messages postés
862
Date d'inscription
mardi 22 mai 2007
Statut
Membre
Dernière intervention
23 octobre 2011
-
26 août 2010 à 11:32
benours Messages postés 862 Date d'inscription mardi 22 mai 2007 Statut Membre Dernière intervention 23 octobre 2011 - 27 août 2010 à 14:56
benours Messages postés 862 Date d'inscription mardi 22 mai 2007 Statut Membre Dernière intervention 23 octobre 2011 - 27 août 2010 à 14:56
A voir également:
- Macro Excel:difficulté parcours d'un tableau
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Liste déroulante excel - Guide
- Word et excel gratuit - Guide
- Si et excel - Guide
- Déplacer une colonne excel - Guide
4 réponses
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 757
26 août 2010 à 13:49
26 août 2010 à 13:49
Bonjour,
Pas à pas :
1- ouvrez votre classeur Excel
2- Sur la feuille concernée, tapez ALT+F11 --> une fenêtre Visual Basic s'ouvre
3- Insertion/Modules
4- copiez collez ce code :
5- fermez la fenêtre visual Basic
6- pour lancer la macro : ALT + F8, choisir "rangement" et Exécuter...
J'ai annoté le code pour une meilleure compréhension, n'hésitez pas à poser vos questions.
Il doit y avoir plus simple, en tout cas plus rapide. C'est assez long, j'ai testé avec 10 000 lignes...
Dis...
Pas à pas :
1- ouvrez votre classeur Excel
2- Sur la feuille concernée, tapez ALT+F11 --> une fenêtre Visual Basic s'ouvre
3- Insertion/Modules
4- copiez collez ce code :
Sub rangement() 'déclaration des variables, i pour la boucle et derlig fin de boucle Dim i, derlig As Integer 'derlig = nombre de lignes de la colonne A divisé par 4 derlig = CInt(Range("A65536").End(xlUp).Row / 4) 'initialise la boucle For i = 1 To derlig 'la syntaxe Cells(ligne, colonne) est facilement accessible Cells(i, 2).Value = Cells(i + 1, 1).Value Cells(i, 3).Value = Cells(i + 2, 1).Value Cells(i, 4).Value = Cells(i + 3, 1).Value 'ici on supprime les lignes entières... Range(Cells(i + 1, 1), Cells(i + 3, 1)).EntireRow.Delete Next End Sub
5- fermez la fenêtre visual Basic
6- pour lancer la macro : ALT + F8, choisir "rangement" et Exécuter...
J'ai annoté le code pour une meilleure compréhension, n'hésitez pas à poser vos questions.
Il doit y avoir plus simple, en tout cas plus rapide. C'est assez long, j'ai testé avec 10 000 lignes...
Dis...
Bidouilleu_R
Messages postés
1181
Date d'inscription
mardi 27 mai 2008
Statut
Membre
Dernière intervention
12 juillet 2012
295
26 août 2010 à 13:51
26 août 2010 à 13:51
un moyen sans utiliser le vba .... à la main peut-être :-(
un petit code pour débuter en vba....
un bon exemple concret aidera davantage.
à partir de la feuille du classeur
Alt F11 ( editeur VBA)
click sur
insertion /module
dans la feuille créée copie et colle le code ci-dessous.
puis avec la touche F8 exécute le en pas à pas
tu verras ce qui se passe.
A+
un petit code pour débuter en vba....
un bon exemple concret aidera davantage.
à partir de la feuille du classeur
Alt F11 ( editeur VBA)
click sur
insertion /module
dans la feuille créée copie et colle le code ci-dessous.
puis avec la touche F8 exécute le en pas à pas
tu verras ce qui se passe.
A+
Sub transposition() Dim NbLig as long Dim I as integer Sheets("feuil1").Select ' à adapter NbLig = Range("a1").CurrentRegion.Rows.Count For I = 0 To nblig Step 4 Range("A1").Offset(I + 1, 0).Resize(3, 1).Select Selection.Copy Range("A1").Offset(I, 1).Resize(1, 3).Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Next ' on efface la ligne entière en controlant 'les vides de la colonne B For I = 1 To NbLig If IsEmpty(Cells(I, 2)) Then Rows(I).Delete I = I - 1 End If Next I End Sub
Bidouilleu_R
Messages postés
1181
Date d'inscription
mardi 27 mai 2008
Statut
Membre
Dernière intervention
12 juillet 2012
295
26 août 2010 à 14:17
26 août 2010 à 14:17
Salut Pijaku,
on s'est croisé je crois..
ta remarque sur la longueur ( nombre de ligne est judicieuse)
on peut accélérer mon code comme ça
Sub transposition()
Dim NbLig As Long
Dim I As Long
Sheets("feuil1").Select ' à adapter
NbLig = Range("a1").CurrentRegion.Rows.Count
Application.ScreenUpdating = False
For I = 0 To NbLig Step 4
Range("A1").Offset(I + 1, 0).Resize(3, 1).Select
Selection.Copy
Range("A1").Offset(I, 1).Resize(1, 3).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Next
' on efface la ligne entière en controlant
'les vides de la colonne B
Range("A1").Select
For I = 1 To NbLig
If IsEmpty(Cells(I, 2)) And Not IsEmpty(Cells(I, 1)) Then
Rows(I).Delete
I = I - 1
End If
Next I
Application.ScreenUpdating = True
Range("A1").Select
End Sub
on s'est croisé je crois..
ta remarque sur la longueur ( nombre de ligne est judicieuse)
on peut accélérer mon code comme ça
Sub transposition()
Dim NbLig As Long
Dim I As Long
Sheets("feuil1").Select ' à adapter
NbLig = Range("a1").CurrentRegion.Rows.Count
Application.ScreenUpdating = False
For I = 0 To NbLig Step 4
Range("A1").Offset(I + 1, 0).Resize(3, 1).Select
Selection.Copy
Range("A1").Offset(I, 1).Resize(1, 3).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Next
' on efface la ligne entière en controlant
'les vides de la colonne B
Range("A1").Select
For I = 1 To NbLig
If IsEmpty(Cells(I, 2)) And Not IsEmpty(Cells(I, 1)) Then
Rows(I).Delete
I = I - 1
End If
Next I
Application.ScreenUpdating = True
Range("A1").Select
End Sub
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 757
26 août 2010 à 14:26
26 août 2010 à 14:26
Salut Bidouilleu,
Oui nos réponses se sont croisées.
Ma remarque sur la lenteur vient de ce que je crois cette procédure réalisable avec une variable tableau... Ca serait certainement plus rapide. Malheureusement, je ne suis pas assez câlé pour ça. Je vais néanmoins essayer.
Oui nos réponses se sont croisées.
Ma remarque sur la lenteur vient de ce que je crois cette procédure réalisable avec une variable tableau... Ca serait certainement plus rapide. Malheureusement, je ne suis pas assez câlé pour ça. Je vais néanmoins essayer.
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 757
26 août 2010 à 15:03
26 août 2010 à 15:03
Version "rapide" si 25000 lignes :
Cordialement,
-- Tout problème à sa solution. S'il n'y a pas de solution, ou est le problème? --
Sub repartition_par_tablo() Dim tablo() As String Dim I, j, k, derlig As Integer derlig = Range("A65536").End(xlUp).Row ReDim tablo(derlig) For I = 1 To UBound(tablo) tablo(I) = Cells(I, 1).Value Next k = 1 derlig = CInt(derlig / 4) For I = 1 To derlig For j = 1 To 4 Cells(I, j).Value = tablo(k) k = k + 1 Next j Next I I = Range("B65536").End(xlUp).Row j = Range("A65536").End(xlUp).Row Range(Cells(I, 1), Cells(j, 1)).EntireRow.Delete End Sub--
Cordialement,
-- Tout problème à sa solution. S'il n'y a pas de solution, ou est le problème? --
benours
Messages postés
862
Date d'inscription
mardi 22 mai 2007
Statut
Membre
Dernière intervention
23 octobre 2011
109
27 août 2010 à 14:56
27 août 2010 à 14:56
Super! Merci beaucoup.
J'ai d'autres sujets qui sont venus s'intercaler avant celui-ci mais je ne manquerai pas de revenir vous faire part de mes commentaires dès que j'aurais trouvé le temps de mettre ce code en oeuvre.
Ce qui est sur, c'est qu'il m'était impossible d'improviser! Merci encore.
Bonne journée.
J'ai d'autres sujets qui sont venus s'intercaler avant celui-ci mais je ne manquerai pas de revenir vous faire part de mes commentaires dès que j'aurais trouvé le temps de mettre ce code en oeuvre.
Ce qui est sur, c'est qu'il m'était impossible d'improviser! Merci encore.
Bonne journée.