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
314
Phil69970
Phil69970
chris6999
  • Question
Microsoft 365 Boucle VB pour supprimer les caractères spéciaux et numériques d'une chaîne
Réponses
5
Affichages
348
patricktoulon
patricktoulon
U
  • Question
Autres incorporer une macro dans une autre macro
Réponses
5
Affichages
292
Phil69970
Phil69970
Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
889
Nicolas JACQUIN
Nicolas JACQUIN
C
  • Question
XL 2021 Problème de remplissage d'une colonne conditionné à d'autres valeurs
Réponses
2
Affichages
313
CathyLD
C
M
  • Question
XL 2010 Aide à la suppression d'un produit en double dans un magasin spécifique avec conditions
Réponses
9
Affichages
660
Mody200
M
C
  • Résolu(e)
XL 2021 Tri alpha sur combobox à 2 colonnes
2
Réponses
15
Affichages
719
dysorthographie
dysorthographie
M
  • Résolu(e)
XL 2016 comment créer une Barre de défilement ou faire simplement défiler son texte ?
2
Réponses
25
Affichages
930
melltel
M
C
  • Résolu(e)
XL 2021 Aide pour affichage colonne listbox après une recherche par textbox
Réponses
10
Affichages
457
Claudinedu13
C
L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
254
Latias
L

Membres actuellement en ligne

11 membres et 110 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
314 653
Messages
2 111 592
Membres
111 208
dernier inscrit
estalavista