Un clasement par hommes et femmes

Sylvie64

XLDnaute Occasionnel
Bonjour,

J'ai un fichier de 137053 lignes, dans la colonne E (en bleu) il y a des prénoms. (voir pj)

J'aimerai savoir s'il est possible d'avoir toutes les femmes sur la page 2 "femmes" et
tous les hommes sur la page3 "hommes" ? (bien sûr la ligne complète)

Si oui, pouvez vous me donner la solution ?
Car je suis incapable de le faire.

Un grand merci pour votre aide.

Sylvie
 

hoerwind

XLDnaute Barbatruc
Re : Un clasement par hommes et femmes

Bonjour, salut Gardien de phare,

D'après ce que je vois en colonne E de l'exemple, toutes les lignes paires sont des hommes, forcément les lignes impaires des femmes.
Toujours d'après l'exemple il n'y aurait aucun célibataire.

Si c'est bien cela, la fonction DECALER devrait répondre à ta question, mais étant donné le nombre de lignes à traiter il me semble qu'une macro serait plus appropriée.

Autre possibilité : créer une colonne supplémentaire avec la formule : =MOD(LIGNE();2) et trier sur 0 ou 1.
Petite limite : il me semble déjà avoir lu que le tri serait limité à 5000 lignes, à vérifier.
 

Gardien de phare

XLDnaute Accro
Re : Un clasement par hommes et femmes

Bonjour,

Le code qui suit devrait faire ton affaire
VB:
Sub divorcer()
Application.ScreenUpdating = False
Dim Dlig As Long, i As Long
With Sheets("Mariages")
' Création des en-tetes
Sheets("Hommes").Range("A1:U1") = .Range("A1:U1").Value
Sheets("Femmes").Range("A1:U1") = .Range("A1:U1").Value
Dlig = .Range("c100000").End(xlUp).Row
' Copie des valeurs
For i = 2 To Dlig - 1 Step 2
Sheets("Hommes").Range("A" & i & ":U" & i) = .Range("A" & i & ":U" & i).Value
Sheets("Femmes").Range("A" & i & ":U" & i) = .Range("A" & i + 1 & ":U" & i + 1).Value
Next
End With
' Suppression des lignes vides
For i = Dlig To 1 Step -1
If Sheets("Hommes").Range("D" & i) = "" Then Sheets("Hommes").Range("D" & i).EntireRow.Delete
If Sheets("Femmes").Range("D" & i) = "" Then Sheets("Femmes").Range("D" & i).EntireRow.Delete
Next
Application.ScreenUpdating = True
End Sub

... en supposant qu'il y a toujours une alternance homme - femme en commençant par un homme.
 

Sylvie64

XLDnaute Occasionnel
Re : Un clasement par hommes et femmes

Bonjour à tous,

Merci pour vos réponses.

hoerwind :
Cela est vraiment une coïncidence que les lignes soient paire "hommes et femmes."

jawhara :
Je vais reprendre mon fichier du départ et rajouter la colonne "sex"

Gardien de phare :
J'ai mis ce code, mais ça fonctionne pas.

Par contre, si je mets une colonnes avec "M" pour hommes et "F" pour femmes cela serait plus facile
je pense.

Si vous pouvez adapter le code avec une colonne "sex" qui se trouvera en colonne "E"

Merci

Sylvie
 

Gardien de phare

XLDnaute Accro
Re : Un clasement par hommes et femmes

Re,

Ca ne fonctionne pas, c'est à dire ? le code plante ? il ne fait rien ? il ne fait pas ce qu'il faut ? Je l'ai testé avant de l'envoyer, chez moi, c'était nickel.

Si tu rajoutes une colonne sexe, on adaptera, pas de problème.
 

Philo

XLDnaute Occasionnel
Re : Un clasement par hommes et femmes

Bonsoir le forum
Le code Gardien du phare fonctionne très bien chez moi aussi
Il faut l'ajouter dans le code de la feuille ThisWorkbook
Tu fait Alt+F11 clique droit sur la feuille ThisWorkbook et un copier coller du code de l'excellent Gardien du phare et après tu exécute la macro le tour et jouer......

Amicalement
 
Dernière édition:

Sylvie64

XLDnaute Occasionnel
Re : Un clasement par hommes et femmes

Bonjour Gardien de phare,

Désoler pour la réponse tardive.

Je me suis mal exprimer, en fait oui le code fonctionne sur le fichier que j'ai envoyé mais pas sur l'original
dont il a 137053 lignes. sur les deux feuilles tout est mélanger hommes et femmes.

Voici le nouveau fichier avec la colonne "sex"

Merci

Sylvie
 

Gardien de phare

XLDnaute Accro
Re : Un clasement par hommes et femmes

Bonjour,

Normalement, le code ci-dessous fait ce que tu veux. Dis-nous si ce n'est pas ça.
VB:
Sub divorcer()
Application.ScreenUpdating = False
Dim Dlig As Long, i As Long
With Sheets("Mariages")
' Création des en-tetes
Sheets("Hommes").Range("A1:U1") = .Range("A1:V1").Value
Sheets("Femmes").Range("A1:U1") = .Range("A1:V1").Value
Dlig = .Range("c100000").End(xlUp).Row
' Copie des valeurs
For i = 2 To Dlig
If Range("E" & i) = "M" Then Sheets("Hommes").Range("A" & i & ":V" & i) = .Range("A" & i & ":V" & i).Value
If Range("E" & i) = "F" Then Sheets("Femmes").Range("A" & i & ":V" & i) = .Range("A" & i & ":V" & i).Value
Next
End With
' Suppression des lignes vides
For i = Dlig To 1 Step -1
If Sheets("Hommes").Range("D" & i) = "" Then Sheets("Hommes").Range("D" & i).EntireRow.Delete
If Sheets("Femmes").Range("D" & i) = "" Then Sheets("Femmes").Range("D" & i).EntireRow.Delete
Next
' Suppresion de la colonne Sexe
Sheets("Hommes").Range("E:E").EntireColumn.Delete
Sheets("Femmes").Range("E:E").EntireColumn.Delete
Application.ScreenUpdating = True
End Sub
 

laetitia90

XLDnaute Barbatruc
Re : Un clasement par hommes et femmes

bonjour tous :):):):)

en passant par un tableau code " brut " pas optimise plus le temps
je lance la macro de la feuil mariage

Code:
Sub es()
Dim t(), t1(), t2(), x As Long, i As Long, y As Byte, a As Byte, z As Long
  t = Range("a2:v" & Cells(Rows.Count, 5).End(xlUp).Row)
  ReDim t1(1 To UBound(t), 1 To 22)
  ReDim t2(1 To UBound(t), 1 To 22)
  For i = 1 To UBound(t)
  If t(i, 5) = "F" Then
  x = x + 1
  For y = 1 To 22: t1(x, y) = t(i, y): Next y
  ElseIf (t(i, 5) = "M") Then
  z = z + 1
  For a = 1 To 22: t2(z, a) = t(i, a): Next a
  End If
  Next i
  Sheets("Femmes").[A2].Resize(x, 22) = t1
  Sheets("Hommes").[A2].Resize(z, 22) = t2
End Sub
 

laetitia90

XLDnaute Barbatruc
Re : Un clasement par hommes et femmes

re, en regardant de plus prés tu as pas 13000 lignes mais + de 130000 cela fait beaucoup!!!!

si la chronologie pas d'importance pour toi on peut faire cela

Code:
Sub ess()
  Dim c As Range, a As Variant, x As Long
  Application.ScreenUpdating = False
  With Sheets("Mariages")
  Set c = .Range("a2:v137053")
  End With
  c.Copy Destination:=Sheets("Femmes").Range("a2")
  With Sheets("Femmes")
  .Range("a2:v137053").Sort Key1:=.Range("e2"), Order1:=xlAscending, Header:=xlGuess
  Set a = .Range("e2", .Cells(Rows.Count, "e").End(xlUp)).Find("M", LookIn:=xlValues, LookAt:=xlWhole)
  .Range("A" & a.Row & ":v137053").Cut Destination:=Sheets("Hommes").Range("a2")
  End With
End Sub

eventuellement passer par des tablos pour la copy pour aller encore plus vite
 

Si...

XLDnaute Barbatruc
Re : Un clasement par hommes et femmes

salut

et ainSI... ?
Dans le Module de la feuille "Mariages"
Code:
Sub H_F()
  Range("$A$1:$V$1").AutoFilter Field:=5, Criteria1:="M"
  Range("A2:V" & Cells(Rows.Count, 2).End(xlUp).Row).Copy Sheets("Hommes").[A2]
  Range("$A$1:$V$1").AutoFilter Field:=5, Criteria1:="F"
  Range("A2:V" & Cells(Rows.Count, 2).End(xlUp).Row).Copy Sheets("Femmes").[A2]
  Selection.AutoFilter
End Sub
 

Discussions similaires

Réponses
7
Affichages
620

Statistiques des forums

Discussions
312 913
Messages
2 093 534
Membres
105 750
dernier inscrit
fred13340