[VBA] Problème Tri alpha (3 lignes)

Staple1600

XLDnaute Barbatruc
Bonsoir le forum


Dans le cadre de la création d'un annuaire
(format imposé)

Je suis confronté au problème suivant:

Les données sont saisies dans un userform
puis reportées dans la feuille adéquate
(en se basant sur la première lettre du nom)
dans la première cellule vide de la colonne A

Or comme les données s'incrivent sur trois lignes
je ne peux donc pas opérer de tri alphabétique.

Dans la version ci-jointe j'ai essayé d'utiliser chr(10)
pour mettre les données sur une seule ligne
mais dans ce cas je perds le format.

Vous trouverez dans l'userform1 deux macros liées au bouton Valider
(celle qui est active est celle qui insère les données sur 3 lignes
l'autre est commentée)

Est-il possible d'opérer un tri alphabétique en identifiant la ligne ou insérer les nouvelles données?
La macro identifierait la ligne contenant le nom précedant, insérerait 3 lignes puis dans
ces 3 nouvelles lignes,les données de l'userform.

Je ne vois pas comment faire autrement.

Merci de votre aide et bonne soirée à tous

Staple

PS: pour tester n'utiliser que des noms allant de A à C
 
Dernière édition:

Luki

XLDnaute Accro
Re : [VBA] Problème Tri alpha (3 lignes)

Bonsoir à tous,

J'ai préparé une ch'tite procédure, finalement assez courte et assez simple pour ventiler les données dans le format requis à partir d'une feuille base.

Elle s'active en auto à l'activation d'une feuille. Mais on peut imaginer l'activer à chaque saisie, aussi.

Si j'active la feuille A., elle va chercher les nom en A, etc.

Code:
Option Compare Text

Sub Ventile(Wks As Worksheet) ' la variable wks est passée par la procédure appelante_
                              ' dans le cas présent, "sheet activate" dans le module this workbook
Dim i%
Dim Cible As Range, RgSource As Range

    If Wks.Name = "Base" Then Exit Sub

    Set RgSource = Worksheets("Base").Range("A1").CurrentRegion
    RgSource.Sort Key1:=Worksheets("Base").Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    
    Wks.Range("A1").CurrentRegion.Clear

    For i = 1 To RgSource.Rows.Count
        If Left(Wks.Name, 1) = Left(RgSource(i, 1), 1) Then
            Set Cible = Wks.Cells(Wks.Range("A65536").End(xlUp).Row + 1, 1)
            With Cible
                .Value = RgSource(i, 1) & " " & RgSource(i, 2)
                .Font.Bold = True
                .Offset(1, 0).Value = RgSource(i, 7)
                .Offset(2, 0).Value = Format(RgSource(i, 3), """Téléphone: ""00\.00\.00\.00\.00")
                .Offset(1, 1).Value = RgSource(i, 5) & " " & RgSource(i, 6)
                .Offset(2, 1).Value = Format(RgSource(i, 4), """Portable: ""00\.00\.00\.00\.00")
            End With
        End If
    Next i
    Wks.Columns.AutoFit
End Sub
A suivre..:)
 

Pièces jointes

  • alpha.xls
    39 KB · Affichages: 59
  • alpha.xls
    39 KB · Affichages: 63
  • alpha.xls
    39 KB · Affichages: 60

Staple1600

XLDnaute Barbatruc
Re : [VBA] Problème Tri alpha (3 lignes)

Bonjour le forum


->luki : impressionnant ta macro.
Je vais tester sous Excel 97 et sur l'annuaire complet.

Et je vais poursuivre (pour le fun) l'idée d'afficher les données
dans un userform (à partir d'une feuille Base).

Merci à tous pour vos idées et aides.


Staple
 

Luki

XLDnaute Accro
Re : [VBA] Problème Tri alpha (3 lignes)

Re Staple,

Merci :p

Je suis entrain de préparer une fonction Split_97 au cas où il faudrait transférer l'annuaire existant (nom et prénom dans la même cellule) dans une feuille Base, on sait jamais... et puis, aussi pour le fun :D

A+
 

Staple1600

XLDnaute Barbatruc
Re : [VBA] Problème Tri alpha (3 lignes)

Bonsoir le forum (Luki)

Pour une fonction Split 97

J'ai une adresse (fs)

Je te l'envoie en MP

Comme cela tu pourras regarder le match
(1 chance sur deux que tu aimes le rugby)

Bonne soirée et merci encore à toi, à tous
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 177
Messages
2 085 972
Membres
103 073
dernier inscrit
MSCHOE16