Discussion :

[ThomasVil]

Bonjour!
Alors voila je vous explique mon problème, j'ai un fichier excel comportant un nom sur la première ligne et toutes les deux colonnes. Par exemple sur A1 il y a "Marie" puis A2,A3 c'est vide, A3 "Julien", A4 et A5 vide... ainsi de suite
J'aimerai pouvoir insérer une nouveau nom parmi ces colonnes et qu'il soit classé dans l'ordre alphabétique tout en conservant la mise en forme: une colonne pleine, 2vides a chaque fois.
Via un sujet un peu similaire à celui ci sur votre site j'ai réussi à récupérer un code qui marchait bien mais il était pour les lignes et ne conservait pas la mise en forme

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Private Sub CommandButton1_Click()
With Sheets("Feuil1")
derlign = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & derlign).Value = Me.TextBox1.Value
 
'classement par ordre alphabétique
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End With
 
    With Sheets("Feuil1").Sort
        .SetRange Range("A1:A" & derlign)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

J'ai donc essayer de le modifier pour que ça fasse le même travail pour les colonnes et c'est la cata Dans le code que j'ai modifié, j'ai aussi essayer de faire une boucle while qui inserera 2 colonnes vierge toutes les colonnes. En effet le code ci dessus supprimait tout les case vierge. Voici mon code modifié ci dessous. Pouvez vous m'aider svp? Merci beaucoup

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
 
Sub CommandButton1_Click()
With Sheets("Tabelle1")
dercolu = .Cells(Columns.Count & "1").End(xlRight).Columns + 1
.Range(dercolu & "1").Value = "Thomas"
 
'classement par ordre alphabétique
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End With
 
    With Sheets("Tabelle1").Sort
        .SetRange Range("A2:dercolu & 2")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   Dim numero As Variant
   numero = 0
    While numero <= dercolu
 
Cells("1" & numero).Select
Selection.EntireColumn.Insert
        numero = numero + 2
    Wend
 
 
End Sub

[MarcelG]

Bonjour,

Pour ma part, je préconiserais le processus suivant:
- Alimentation d'une variable Tableau de toutes les cellules non vides
- Tri de ce tableau dans l'ordre croissant
- Effacement de la ligne
- Report des items du tableau créé toutes les 3 colonnes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Option Explicit
 
Sub tri_colonnes()
 
Dim derncol As Integer
Dim c As Range
 
Dim Tablo() As Variant
 
Dim a As Integer
a = 0
 
With Worksheets("lawks")
        derncol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        .Cells(1, derncol + 1).Value = "Pierre"
        For Each c In .Range("A1", .Cells(1, derncol + 1))
                With c
                        If Trim(.Value) <> "" Then
                                a = a + 1
                                ReDim Preserve Tablo(1 To a)
                                Tablo(a) = Trim(.Value)
                        End If
                End With
        Next c
End With
 
Dim valeur As Integer
Dim i As Integer
Dim cible As Variant
 
Do 'tri croissant
            valeur = 0
            For i = LBound(Tablo) To UBound(Tablo) - 1
                If LCase(Tablo(i)) > LCase(Tablo(i + 1)) Then
                    cible = Tablo(i)
                    Tablo(i) = Tablo(i + 1)
                    Tablo(i + 1) = cible
                    valeur = 1
                End If
            Next i
Loop While valeur = 1
 
a = 0
 
With Worksheets("lawks")
        .Range("A1", .Cells(1, derncol + 1)).ClearContents
        For i = LBound(Tablo) To UBound(Tablo) * 3 Step 3
                a = a + 1
                .Cells(1, i).Value = Tablo(a)
        Next i
End With
 
End Sub

[ThomasVil]

Merci beaucoup ça marche presque parfaitement! en fait j'avais oublié d'indiquer dans mon premier message que lorsqu'il y a triage dans l'ordre alphabétique, tout ceux qui se situe en dessous du nom doit également se retrouver à la nouvelle position du nom. Par exemple à la ligne en dessous du nom marie il y a son age, encore en dessous sa ville de naissance etc... Savez vous ce qu'il faut changer pour que ça marche? Encore merci et désolé d'avoir oublié cette partie du problème!

[boisgontierjacques]

Bonjour,

Un exemple de tri par bloc

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub Tri(LigneDébut, HauteurBloc, numCol, ordre, DecalTri)
  nbcol = Cells(LigneDébut, 1).CurrentRegion.Columns.Count
  Columns("A:A").Offset(0, nbcol).Insert Shift:=xlToRight
  i = LigneDébut
  Do While i <= [a65000].End(xlUp).Row
    Cells(i, nbcol + 1).Resize(HauteurBloc, 1) = Cells(i + DecalTri, numCol)
    i = i + HauteurBloc
  Loop
  derLig = Cells(65000, nbcol + 1).End(xlUp).Row
  Range(Cells(LigneDébut, 1), Cells(derLig, nbcol + 1)).Sort _
     Key1:=Cells(LigneDébut + 1, 1).Offset(0, nbcol), Order1:=ordre, Header:=xlNo
  [A:A].Offset(0, nbcol).Delete Shift:=xlToLeft
End Sub
 
Sub triNom()
  Tri 2, 3, 1, xlAscending, 0
End Sub
 
Sub triDateNaissance()
  Tri 2, 3, 3, xlDescending, 0
End Sub
 
Sub triDateEntrée()
  Tri 2, 3, 2, xlAscending, 0
End Sub

Boisgontier

[MarcelG]

Hé salut Jacques.

J'étais justement sur la lecture de l'un de tes post.
Sans doute, pourrait-on partir ce cette base (Tri de tableau VBA à 2 dimensions), pour compléter le processus que j'ai indiqué plus avant.

[ThomasVil]

Merci pour votre réponse malheureusement celle ci ne fonctionne pas dans mon fichier excel. En effet rien ne se passe. Aussi quand je parlais de l'age, la ville etc c'était des exemples, j'aimerai bien que ça marche pour n'importe quelles données se situant sous les noms. Savez vous pourquoi votre code ne marche pas chez moi?
Merci Pour tout,

ah oui désolé je voulais dire un nom sur A1 puis B1,C1 vide puis un nouveau sur D1... et en dessous de A1 sur A2 jusqu'à A50 il y a a des données par exemple
Merci!

[patricktoulon]

re
Salut

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
[Option Explicit
Sub AddNewPrenom()
   'test ajout du prenom "Amber"
    Dim p As Range, t
    With Sheets(1)
        Set p = .Range("A1", .Cells(Rows.Count, 1).End(xlUp))
        t = TableOrderName(p, "Amber")
        Cells(1, 2).Resize(UBound(t), 1) = Application.Transpose(t)   'REMPLACER "2" PAR 1 POUR LA REMETTRE EN COLONNE A
    End With
End Sub
'
'
Function TableOrderName(p As Range, newprenom As String)
    Dim tbl(), tbl2(), cel As Range, a&, i&, i2&, x&, temp$
    For Each cel In p.Cells
        If Not IsEmpty(cel) Then a = a + 1: ReDim Preserve tbl(1 To a): tbl(a) = cel.Value
    Next
    'Add new prenom
    a = a + 1: ReDim Preserve tbl(1 To a): tbl(a) = newprenom
    'in order
    For i = 1 To UBound(tbl)
        For i2 = i + 1 To UBound(tbl)
            If tbl(i2) < tbl(i) Then temp = tbl(i): tbl(i) = tbl(i2): tbl(i2) = temp
        Next i2
    Next i
    'add interval(two line)
    For i = 1 To UBound(tbl)
        x = x + IIf(i = 1, 1, 3): ReDim Preserve tbl2(1 To x): tbl2(x) = tbl(i)
    Next
    TableOrderName = tbl2
End Function

je tiens a préciser quand même que la demande est ambiguë
je cite

j'ai un fichier excel comportant un nom sur la première ligne et toutes les deux colonnes. Par exemple sur A1 il y a "Marie" puis A2,A3 c'est vide, A3 "Julien", A4 et A5 vide... ainsi de suite

jusqu'à preuve du contraire A1,A2,A3,A4,A5,etc.. sont dans la même colonne

[patricktoulon]

re

soit!!!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 
Option Explicit
Sub AddNewPrenom()
   'test ajout du prenom "Amber"
    Dim p As Range, t
    With Sheets(1)
        Set p = .Range("A1", .Cells(1, Columns.Count).End(xlToLeft))
        t = TableOrderName(p, "Amber")
        Cells(2, 1).Resize(1, UBound(t)) = t
    End With
End Sub
'
'
Function TableOrderName(p As Range, newprenom As String)
    Dim tbl(), tbl2(), cel As Range, a&, i&, i2&, x&, temp$
    For Each cel In p.Cells
        If Not IsEmpty(cel) Then a = a + 1: ReDim Preserve tbl(1 To a): tbl(a) = cel.Value
    Next
    'Add new prenom
    a = a + 1: ReDim Preserve tbl(1 To a): tbl(a) = newprenom
    'in order
    For i = 1 To UBound(tbl)
        For i2 = i + 1 To UBound(tbl)
            If tbl(i2) < tbl(i) Then temp = tbl(i): tbl(i) = tbl(i2): tbl(i2) = temp
        Next i2
    Next i
    MsgBox Join(tbl, ",")
    'add interval(two line)
    For i = 1 To UBound(tbl)
        x = x + IIf(i = 1, 1, 3): ReDim Preserve tbl2(1 To x): tbl2(x) = tbl(i)
    Next
    TableOrderName = tbl2
End Function

[patricktoulon]

re
si les données en ligne 2,3,etc.... doivent suivre tu n'a pas besoin de boucle
tu détermine le xltoleft) de ta ligne tu met ton nouveau prénom dans l'offset(,3)
et tu fait un tri A a Z horizontal
comme quoi une demande claire ....... hein !!!

[boisgontierjacques]

>Merci pour votre réponse malheureusement celle ci ne fonctionne pas dans mon fichier excel. En effet rien ne se passe.

Si vous aviez essayé le fichier joint, vous auriez constaté qu'il fonctionnait.

PS: Avec un Array(), la présentation ne serait pas préservée.

Boisgontier