Tri automatique et insertion de ligne [Résolu]
A voir également:
- Tri automatique et insertion de ligne
- PHP : Insertion de ligne en plein milieu d'un tableau php avec index numérique - CodeS Source - Guide
- Tri alphabétique par insertion - Codes sources - Visual Basic / VB.NET (VBScript)
- Tri automatique d'une zone excel dès que l'on change une valeure. - Codes sources - Visual Basic / VB.NET (Trucs & Astuces)
- Liste double trie a l'insertion avec une pile - Codes sources - C / C++ / C++.NET (Divers)
- Visual Basic / VB.NET : Extract active directory et trie automatique - CodeS SourceS - Guide
5 réponses
Bonjour,
ceci
>>> finOA = Sheets("Bilan OA").Range("A2").End(xlDown).Row
va fonctionner seulement s'il n'y a pas de cellules vides en colonne A
Utilise plutôt
>>> finOA = Sheets("Bilan OA").Cells(Rows.count, "A").End(xlUp).Row
Évite les Select.
Ce n'est pas nécessaire et ça ralentit le processus pour rien même si ce n'est pas beaucoup...
Range("A3:J" & finOA).Select
Selection.Sort Key1:=Range("B2"),....
se traduit par
Range("A3:J" & finOA).Sort Key1:=Range("B2"),....
Pour la boucle je préfère le For...Next, mais c'est une question de choix
Quand tu postes du code, utilise le 3e icône en partant de la droite.
Sélectionne ton code et clique VB
Et indente ton code pour faciliter la lecture
MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI
ceci
>>> finOA = Sheets("Bilan OA").Range("A2").End(xlDown).Row
va fonctionner seulement s'il n'y a pas de cellules vides en colonne A
Utilise plutôt
>>> finOA = Sheets("Bilan OA").Cells(Rows.count, "A").End(xlUp).Row
Évite les Select.
Ce n'est pas nécessaire et ça ralentit le processus pour rien même si ce n'est pas beaucoup...
Range("A3:J" & finOA).Select
Selection.Sort Key1:=Range("B2"),....
se traduit par
Range("A3:J" & finOA).Sort Key1:=Range("B2"),....
Pour la boucle je préfère le For...Next, mais c'est une question de choix
For I = FinOA to 3 step -1 'ici tu peux mettre 3 plutôt que 2 puisque la 2e ligne sera différente de l'entête
If Range("B" & I) <> Range("B" & I - 1) Then
Rows(I).Insert
End if
Next
Quand tu postes du code, utilise le 3e icône en partant de la droite.
Sélectionne ton code et clique VB
Et indente ton code pour faciliter la lecture
MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI
Bonjour,
Pas nécessaire d'ouvrir 2 post pour le même problème...
Quand tu insères ou effaces des lignes, boucle à partir de la fin en remontant.
Donc, vérifie si la valeur en ligne courante est différente de la précédente.
Si oui, tu insères ta ligne.
MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI
Pas nécessaire d'ouvrir 2 post pour le même problème...
Quand tu insères ou effaces des lignes, boucle à partir de la fin en remontant.
Donc, vérifie si la valeur en ligne courante est différente de la précédente.
Si oui, tu insères ta ligne.
MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI
Désolé je pensais que ça n'avait pas fonctionné la première fois.
C'est une bonne idée, je vais essayer de traduire ça avec du texte.
Merci de m'aider
C'est une bonne idée, je vais essayer de traduire ça avec du texte.
Merci de m'aider
Bonjour,
Désolé de vous ennuyer avec mon problème mais malheureusement je n'arrive pas à obtenir à 100% le résultat souhaité.
Voici mon code:
Sheets("Bilan OA").Activate
finOA = Sheets("Bilan OA").Range("A2").End(xlDown).Row
Range("A3:J" & finOA).Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Range("B3:B" & finOA).Select
Agence = Range("B" & finOA).Value
agencecourante = Range("B" & finOA).Value
Do
agencecourante = Range("B" & finOA).Value
If agencecourante = Agence Then 'And agencecourante <> ""
j = finOA
Else: Rows("" & finOA + 1).Select
Selection.Insert shift:=xlDown
j = finOA - 1
Agence = Range("B" & j).Value
End If
finOA = finOA - 1
Loop Until finOA = 2
J'ai le sentiment que j'ai un souci au niveau de ma boucle qui me fait perdre une ligne car aux tests, si je n'ai qu'une seule ligne par catégorie alors la ligne n'est pas insérée ou une fois sur deux
Désolé de vous ennuyer avec mon problème mais malheureusement je n'arrive pas à obtenir à 100% le résultat souhaité.
Voici mon code:
Sheets("Bilan OA").Activate
finOA = Sheets("Bilan OA").Range("A2").End(xlDown).Row
Range("A3:J" & finOA).Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Range("B3:B" & finOA).Select
Agence = Range("B" & finOA).Value
agencecourante = Range("B" & finOA).Value
Do
agencecourante = Range("B" & finOA).Value
If agencecourante = Agence Then 'And agencecourante <> ""
j = finOA
Else: Rows("" & finOA + 1).Select
Selection.Insert shift:=xlDown
j = finOA - 1
Agence = Range("B" & j).Value
End If
finOA = finOA - 1
Loop Until finOA = 2
J'ai le sentiment que j'ai un souci au niveau de ma boucle qui me fait perdre une ligne car aux tests, si je n'ai qu'une seule ligne par catégorie alors la ligne n'est pas insérée ou une fois sur deux