XL pour MAC Tri sur listes noms composés

pierlille

pierlille

XLDnaute Nouveau
Bonjour,
J'ai une très longue liste composées de PRENOMS et NOMS
Je parviens à l'aide d'une macro à trier cette liste afin de séparer les données qui sont des PRENOMS ou des NOMS composés

VB: 
Sub jj()
Dim Derlg As Long, C As Object
Feuil2.Columns("a:b").Clear
Feuil3.Columns("a:b").Clear
For Each C In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    If C Like "* *" Or C Like "*-*" Or C.Offset(, 1) Like "* *" Or C.Offset(, 1) Like "*-*" Then
        Derlg = Feuil2.Cells(Rows.Count, 1).End(xlUp).Row + 1
        Feuil2.Cells(Derlg, 1) = C
        Feuil2.Cells(Derlg, 2) = C.Offset(, 1)
    Else
        Derlg = Feuil3.Cells(Rows.Count, 1).End(xlUp).Row + 1
        Feuil3.Cells(Derlg, 1) = C
        Feuil3.Cells(Derlg, 2) = C.Offset(, 1)
    End If
Next
End Sub

Par contre je ne sais pas comment faire pour trier la même liste qui contient 3 colonnes.
En fait je voudrais faire la même chose qu'avec le code précédent mais en ajoutant un colonne "VILLE"
Mon fichier exemple est disponible ici : LIEN

Merci d'avance pour votre aide.

Pierre
 

Pièces jointes

  • trinoms.xlsm
    22.6 KB · Affichages: 13
Trier par date Trier par votes
Jacky67

Jacky67

XLDnaute Barbatruc
pierlille à dit:
Bonjour,
J'ai une très longue liste composées de PRENOMS et NOMS
Je parviens à l'aide d'une macro à trier cette liste afin de séparer les données qui sont des PRENOMS ou des NOMS composés

VB: 
Sub jj()
Dim Derlg As Long, C As Object
Feuil2.Columns("a:b").Clear
Feuil3.Columns("a:b").Clear
For Each C In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    If C Like "* *" Or C Like "*-*" Or C.Offset(, 1) Like "* *" Or C.Offset(, 1) Like "*-*" Then
        Derlg = Feuil2.Cells(Rows.Count, 1).End(xlUp).Row + 1
        Feuil2.Cells(Derlg, 1) = C
        Feuil2.Cells(Derlg, 2) = C.Offset(, 1)
    Else
        Derlg = Feuil3.Cells(Rows.Count, 1).End(xlUp).Row + 1
        Feuil3.Cells(Derlg, 1) = C
        Feuil3.Cells(Derlg, 2) = C.Offset(, 1)
    End If
Next
End Sub

Par contre je ne sais pas comment faire pour trier la même liste qui contient 3 colonnes.
En fait je voudrais faire la même chose qu'avec le code précédent mais en ajoutant un colonne "VILLE"
Mon fichier exemple est disponible ici : LIEN

Merci d'avance pour votre aide.

Pierre
Cliquez pour agrandir...
Bonjour
Essaye comme ceci
VB: 
Sub jj()
    Dim Derlg As Long, C As Object
    Application.ScreenUpdating = False
    Feuil2.Columns("a:c").Clear: Feuil3.Columns("a:c").Clear
    Feuil1.Range("A1:C1").Copy Feuil2.[a1]: Feuil1.Range("A1:C1").Copy Feuil3.[a1]
    For Each C In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        If C Like "* *" Or C Like "*-*" Or C.Offset(, 1) Like "* *" Or C.Offset(, 1) Like "*-*" Then
            Derlg = Feuil2.Cells(Rows.Count, 1).End(xlUp).Row + 1
            Feuil2.Cells(Derlg, 1) = C
            Feuil2.Cells(Derlg, 2) = C.Offset(, 1)
            Feuil2.Cells(Derlg, 3) = C.Offset(, 2)
        Else
            Derlg = Feuil3.Cells(Rows.Count, 1).End(xlUp).Row + 1
            Feuil3.Cells(Derlg, 1) = C
            Feuil3.Cells(Derlg, 2) = C.Offset(, 1)
            Feuil3.Cells(Derlg, 3) = C.Offset(, 2)
        End If
    Next
    Application.CutCopyMode = False
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Jacky67

Jacky67

XLDnaute Barbatruc
pierlille à dit:
Merci Jacky !

J'ai copié/collé le code que vous proposez mais... cela ne fonctionne pas !... Et je ne comprends pas pourquoi ?
Cliquez pour agrandir...
Re...
Et qu'est qui ne fonctionne pas ?
Cette macro avec un clic sur le bouton rajoute les villes comme demandé
//En fait je voudrais faire la même chose qu'avec le code précédent mais en ajoutant un colonne "VILLE"//
Si elle est lancé dans l'editeur vba, la feuil1 doit être active, sinon il faut préciser la feuil1 dans
For Each C In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
 
Dernière édition:
Vote positif 0 Vote négatif
pierlille

pierlille

XLDnaute Nouveau
...en fait avec ce code qui est adapté de ce que vous avez proposé j'obtiens ce que je voulais.
Merci beaucoup Jacky :)

VB: 
Sub jj()
Dim Derlg As Long, C As Object
Feuil2.Columns("a:b").Clear
Feuil3.Columns("a:b").Clear
For Each C In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    If C Like "* *" Or C Like "*-*" Or C.Offset(, 1) Like "* *" Or C.Offset(, 1) Like "*-*" Then
        Derlg = Feuil2.Cells(Rows.Count, 1).End(xlUp).Row + 1
        Feuil2.Cells(Derlg, 1) = C
        Feuil2.Cells(Derlg, 2) = C.Offset(, 1)
        Feuil2.Cells(Derlg, 3) = C.Offset(, 2)
    Else
        Derlg = Feuil3.Cells(Rows.Count, 1).End(xlUp).Row + 1
        Feuil3.Cells(Derlg, 1) = C
        Feuil3.Cells(Derlg, 2) = C.Offset(, 1)
        Feuil3.Cells(Derlg, 3) = C.Offset(, 2)
    End If
Next
End Sub
 
Vote positif 0 Vote négatif
Jacky67

Jacky67

XLDnaute Barbatruc
pierlille à dit:
...en fait avec ce code qui est adapté de ce que vous avez proposé j'obtiens ce que je voulais.
Merci beaucoup Jacky :)

VB: 
Sub jj()
Dim Derlg As Long, C As Object
Feuil2.Columns("a:b").Clear
Feuil3.Columns("a:b").Clear
For Each C In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    If C Like "* *" Or C Like "*-*" Or C.Offset(, 1) Like "* *" Or C.Offset(, 1) Like "*-*" Then
        Derlg = Feuil2.Cells(Rows.Count, 1).End(xlUp).Row + 1
        Feuil2.Cells(Derlg, 1) = C
        Feuil2.Cells(Derlg, 2) = C.Offset(, 1)
        Feuil2.Cells(Derlg, 3) = C.Offset(, 2)
    Else
        Derlg = Feuil3.Cells(Rows.Count, 1).End(xlUp).Row + 1
        Feuil3.Cells(Derlg, 1) = C
        Feuil3.Cells(Derlg, 2) = C.Offset(, 1)
        Feuil3.Cells(Derlg, 3) = C.Offset(, 2)
    End If
Next
End Sub
Cliquez pour agrandir...
Re..
Si tu es certain fait le….
Tu n'effaces pas la colonne C des feuilles concernées
Tu commences la lecture en ligne 1 alors que les noms commencent en ligne 2
Tu n' as pas de titre correcte
Mais bon, c'est toi qui vois
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonsoir pierlille, Jacky67,

Puisque la la liste est longue il ne faut surtout pas travailler sur les cellules mais utiliser des tableaux VBA :
VB: 
Sub jj()
Dim ncol%, tablo, resu1(), resu2(), i&, n&, j%, p&
ncol = 3 'nombre de colonnes à adapter éventuellement
tablo = Feuil1.[A1].CurrentRegion.Resize(, ncol) 'matrice, plus rapide
ReDim resu1(1 To UBound(tablo), 1 To ncol)
ReDim resu2(1 To UBound(tablo), 1 To ncol)
For i = 2 To UBound(tablo)
    If InStr(tablo(i, 1) & tablo(i, 2), " ") + InStr(tablo(i, 1) & tablo(i, 2), "-") Then
        n = n + 1
        For j = 1 To ncol: resu1(n, j) = tablo(i, j): Next j
    Else
        p = p + 1
        For j = 1 To ncol: resu2(p, j) = tablo(i, j): Next j
    End If
Next i
With Feuil2.[A2]
    If n Then .Resize(n, ncol) = resu1
    .Offset(n).Resize(Rows.Count - n - .Row + 1, ncol).ClearContents 'RAZ en dessous
End With
With Feuil3.[A2]
    If p Then .Resize(p, ncol) = resu2
    .Offset(p).Resize(Rows.Count - p - .Row + 1, ncol).ClearContents 'RAZ en dessous
End With
End Sub
A+
 

Pièces jointes

  • trinoms(1).xlsm
    24.1 KB · Affichages: 13
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
Microsoft 365 Code VBA Envoi contenu tableau Excel par Email
Réponses
1
Affichages
111
Phil69970
Phil69970
_l_ours
  • Résolu(e)
XL 2016 Macro Dim c As Range, i As Long
Réponses
8
Affichages
221
mapomme
mapomme
C
  • Résolu(e)
XL 2021 Tri alpha sur combobox à 2 colonnes
2
Réponses
15
Affichages
358
dysorthographie
dysorthographie
C
  • Résolu(e)
XL 2021 Aide pour affichage colonne listbox après une recherche par textbox
Réponses
10
Affichages
247
Claudinedu13
C
L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
76
Latias
L
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
916
thivame
T
D
  • Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
253
Dranreb
Dranreb
F
  • Question
XL 2016 Comparer 2 tableaux
Réponses
4
Affichages
518
fil28
F
H
  • Question
Autres mise a jour automatique feuille excel vba
Réponses
2
Affichages
287
HANN
H
P
  • Question
XL 2019 Reduire le temps d'excution VBA - code mal optimisé
Réponses
9
Affichages
594
TooFatBoy
TooFatBoy

Membres actuellement en ligne

16 membres et 363 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 191
Messages
2 086 052
Membres
103 109
dernier inscrit
boso_vs_viking