Extraire certaines lignes

cassandre27

cassandre27

XLDnaute Nouveau
Bonjour,

J'ai déjà eu besoin de votre forum, et on m'a vraiment aidé (merci encore), et là j'aurai besoin de vos lumières, encore !!

Alors je joins un fichier excel en exemple et j'explique :

Je voudrais que les lignes Date E qui sont égales au lignes Date S soient sur une autre feuille, en sachant qu'il faut prendre toutes les lignes du même nom :
Pour aaa la ligne 4B et 4C sont égales, donc mettre toutes les lignes aaa sur une autre feuille.

Ensuite sur l'autre feuille où les lignes sont extraites, additionnées les lignes SSSS dans une colonne à coté.

Merci encore
 

Pièces jointes

  • exemple.xls
    33.5 KB · Affichages: 122
  • exemple.xls
    33.5 KB · Affichages: 125
  • exemple.xls
    33.5 KB · Affichages: 114
Trier par date Trier par votes
ChTi160

ChTi160

XLDnaute Barbatruc
Re : Extraire certaines lignes

Re

Chez moi cela fonctionne très bien sur le fichier exemple, donc je ne vois pas d'où cela put venir.

Pour ma culture personnelle ,et avant de passer la main à JB Lol

Quel message d'erreur as tu ,merci D'avance

Dans l'attente

Bonne fin de Journée :confused:
 
Vote positif 0 Vote négatif
cassandre27

cassandre27

XLDnaute Nouveau
Re : Extraire certaines lignes

Et bien oui le problème sur le fichier exemple ça marche bien, et ça fait bien les lignes vertes !!
Mais je lance la macro, la ligne ça l'a mets en jaune !!! donc je suppose que ça veut dire qu'il y a une erreur ?
 
Vote positif 0 Vote négatif
BOISGONTIER

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Extraire certaines lignes

Si les noms identiques ne sont pas regroupés, il faut ajouter un tri

JB
 

Pièces jointes

  • exemple2(1).xls
    48 KB · Affichages: 57
  • exemple2(1).xls
    48 KB · Affichages: 59
  • exemple2(1).xls
    48 KB · Affichages: 58
Vote positif 0 Vote négatif
cassandre27

cassandre27

XLDnaute Nouveau
Re : Extraire certaines lignes

Alors la je comprends plus rien, je viens de retester sur mon tableau réel, maintenant ça me mets une erreur sur la ligne :

Public TabRecup() As Variant

et le message erreur de compilation, alors que ce matin quand j'ai testé c'était une ligne qui était surligné en jaune !!!
 
Vote positif 0 Vote négatif
cassandre27

cassandre27

XLDnaute Nouveau
Re : Extraire certaines lignes

BOISGONTIER à dit:
Si les noms identiques ne sont pas regroupés, il faut ajouter un tri

JB
Cliquez pour agrandir...

Et bien je viens de retester, c'est bien les totaux qui sont pas bons !!!
par exemple il y a plusieurs sommes à additionner et ça mets total 0 !!
ou quand il y a des sommes à 0, le total reprends une somme qui est marqué sur un nom avant !!!
Alors que sur l'exemple ça marche bien !!!!:confused:
 
Vote positif 0 Vote négatif
BOISGONTIER

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Extraire certaines lignes

Le tri par nom a t-il était ajouté?

Code: 
Sub Essai()
  Set f1 = Sheets("feuil1")
  Set f2 = Sheets("feuil2")
  f1.Range("A1:W65000").Sort Key1:=f1.Range("B2"), Order1:=xlAscending, Header:=xlGuess

  f2.Cells(2, 1).Resize(1000, 50).Clear
  '-- recherche noms
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In f1.Range("b2", f1.[b65000].End(xlUp))
    If Not mondico.Exists(c.Value) And c.Offset(0, 3) = c.Offset(0, 4) Then
      mondico.Add c.Value, c.Value
    End If
  Next c
  '-- recherche des lignes de chaque nom
  ligne2 = 2
  For Each c In mondico.items
    Set x = f1.[B:B].Find(what:=c)
    ligne = x.Row
    totalO = 0
    totalP = 0
    
    Do While f1.Cells(ligne, 2) = c
      For i = 1 To 4
        f2.Cells(ligne2, i).Value = f1.Cells(ligne, i).Value
      Next
      For i = 5 To 6
        f2.Cells(ligne2, i).Value = CDate(f1.Cells(ligne, i).Text)
      Next i
      For i = 7 To 23
        f2.Cells(ligne2, i).Value = f1.Cells(ligne, i).Value
      Next i
      totalO = totalO + Cells(ligne, "O").Value
      totalP = totalP + Cells(ligne, "P").Value
      ligne = ligne + 1
      ligne2 = ligne2 + 1
    Loop
    f2.Cells(ligne2, "N") = "Total"
    f2.Cells(ligne2, "N").Resize(1, 3).Font.Bold = True
    f2.Cells(ligne2, "O") = totalO
    f2.Cells(ligne2, "P") = totalP
    ligne2 = ligne2 + 2
  Next c
End Sub

JB
 
Vote positif 0 Vote négatif
cassandre27

cassandre27

XLDnaute Nouveau
Re : Extraire certaines lignes

BOISGONTIER à dit:
Le tri par nom a t-il était ajouté?

Code: 
Sub Essai()
  Set f1 = Sheets("feuil1")
  Set f2 = Sheets("feuil2")
  f1.Range("A1:W65000").Sort Key1:=f1.Range("B2"), Order1:=xlAscending, Header:=xlGuess

  f2.Cells(2, 1).Resize(1000, 50).Clear
  '-- recherche noms
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In f1.Range("b2", f1.[b65000].End(xlUp))
    If Not mondico.Exists(c.Value) And c.Offset(0, 3) = c.Offset(0, 4) Then
      mondico.Add c.Value, c.Value
    End If
  Next c
  '-- recherche des lignes de chaque nom
  ligne2 = 2
  For Each c In mondico.items
    Set x = f1.[B:B].Find(what:=c)
    ligne = x.Row
    totalO = 0
    totalP = 0
    
    Do While f1.Cells(ligne, 2) = c
      For i = 1 To 4
        f2.Cells(ligne2, i).Value = f1.Cells(ligne, i).Value
      Next
      For i = 5 To 6
        f2.Cells(ligne2, i).Value = CDate(f1.Cells(ligne, i).Text)
      Next i
      For i = 7 To 23
        f2.Cells(ligne2, i).Value = f1.Cells(ligne, i).Value
      Next i
      totalO = totalO + Cells(ligne, "O").Value
      totalP = totalP + Cells(ligne, "P").Value
      ligne = ligne + 1
      ligne2 = ligne2 + 1
    Loop
    f2.Cells(ligne2, "N") = "Total"
    f2.Cells(ligne2, "N").Resize(1, 3).Font.Bold = True
    f2.Cells(ligne2, "O") = totalO
    f2.Cells(ligne2, "P") = totalP
    ligne2 = ligne2 + 2
  Next c
End Sub

JB
Cliquez pour agrandir...


Alors oui ça trie bien par noms, mais ça m'arrange pas, car moi je veux que se soit trié par n°ss, car plusieurs personnes peuvent avoir le meme nom !!
Et les totaux sont toujours faux !!!
 
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
Re : Extraire certaines lignes

Re
Alors pourquoi ne fais tu pas le transféré par rapport au numéro de SS plutôt que le Nom
si Dates égales alors on récupère le n°SS et Oupsss

et moi je sais toujours pas pourquoi ça fonctionne Pas Lol ,,,,, bizarre non ???

les N° SS sont sensés être en colonne A c'est çà ?
Bonne fin de Journée
 
Dernière édition:
Vote positif 0 Vote négatif
cassandre27

cassandre27

XLDnaute Nouveau
Re : Extraire certaines lignes

bon je viens de tester, sur le tableau d'exemple ça marche mais sur mon tableau et ben non !!!

Alors je te mets le message d'erreur sur cette ligne au début du programme :

Public TabRecup() As Variant


Ca me mets :

Erreur de compilation:

Des constantes, chaînes de longueur fixe, tableaux, types définis par l'utilisateur et instructions Declare ne sont pas autorisés comme membres Public de modules d'objet
 
Vote positif 0 Vote négatif
BOISGONTIER

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Extraire certaines lignes

Il est dans quelle colonne le No SS?

Trié par NNI (colonneA)

KERO et LEM ont le même no?? (284)

Code: 
Sub Essai()
  Set f1 = Sheets("feuil1")
  Set f2 = Sheets("feuil2")
  f1.Range("A1:W65000").Sort Key1:=f1.Range("A2"), Order1:=xlAscending, Header:=xlGuess

  f2.Cells(2, 1).Resize(1000, 50).Clear
  '-- recherche noms
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In f1.Range("a2", f1.[a65000].End(xlUp))
    If Not mondico.Exists(c.Value) And c.Offset(0, 4) = c.Offset(0, 5) Then
      mondico.Add c.Value, c.Value
    End If
  Next c
  '-- recherche des lignes de chaque nom
  ligne2 = 2
  For Each c In mondico.items
    Set x = f1.[a:a].Find(what:=c)
    ligne = x.Row
    totalO = 0
    totalP = 0
    
    Do While f1.Cells(ligne, 1) = c
      For i = 1 To 4
        f2.Cells(ligne2, i).Value = f1.Cells(ligne, i).Value
      Next
      For i = 5 To 6
        f2.Cells(ligne2, i).Value = CDate(f1.Cells(ligne, i).Text)
      Next i
      For i = 7 To 23
        f2.Cells(ligne2, i).Value = f1.Cells(ligne, i).Value
      Next i
      totalO = totalO + Cells(ligne, "O").Value
      totalP = totalP + Cells(ligne, "P").Value
      ligne = ligne + 1
      ligne2 = ligne2 + 1
    Loop
    f2.Cells(ligne2, "N") = "Total"
    f2.Cells(ligne2, "N").Resize(1, 3).Font.Bold = True
    f2.Cells(ligne2, "O") = totalO
    f2.Cells(ligne2, "P") = totalP
    ligne2 = ligne2 + 2
  Next c
End Sub
 

Pièces jointes

  • exemple2(1)B.xls
    48.5 KB · Affichages: 56
Dernière édition:
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
Re : Extraire certaines lignes

Re
apparemment il s'agit d'une erreur de placement de la variable

comment as tu fais pour placer le code du fichier test ,dans ton fichier et ou l'as tu placé ?
dans un Module Standard ,Module de Classe, etc

Dans l'attente
Bonne fin de Soirée
 
Vote positif 0 Vote négatif
cassandre27

cassandre27

XLDnaute Nouveau
Re : Extraire certaines lignes

ChTi160 à dit:
Re
apparemment il s'agit d'une erreur de placement de la variable

comment as tu fais pour placer le code du fichier test ,dans ton fichier et ou l'as tu placé ?
dans un Module Standard ,Module de Classe, etc

Dans l'attente
Bonne fin de Soirée
Cliquez pour agrandir...

Je viens de réessayer, à n'y rien comprendre ça marche !! Bon je ne crie pas victoire, car j'ai testé sur un p'tit fichier, par rapport au fichier de 60 000 lignes, mais là ça marche !!
Sinon je fais un copier coller dans un module standard !! A n'y rien comprendre, donc dés demain matin j'essaye sur le gros fichier !!!

Pour répondre à Boisgontier, oui le n° ss est la colonne A, mais en effaçant les n° j'ai pas fait attention que 2 avait les mêmes !!

Merci encore à vous deux, et dés demain je vous dit si ça marche ou pas !!


Car maintenant, les totaux qui me ressortent pour chaque personne, il faut leur calculer un plafond !!

Je m'explique, les totaux sont des salaires brut, et le plafond de la Sécu est de 2682 par mois, 32184 à l'année.
Donc tout ce qui dépasse le plafond passe dans une autre colonne que l'on va appeler T2.
Mais le soucis du calcul va être , le Salaire Brut, par la date d'entrée et de Sortie, et le Temps partiel !!

Un exemple :

personne 1 date 01.01.2007 au 31.12.2007 salaire 20 000.

Tout reste en TA (comme il dépasse pas le plafond)

Personne 2 date 15.01.2007 au 15.06.2007 est à 50 % Salaire 10 000

Ca fait 6705 en TA et 3295 en T2 (du 15.01 au 15.06 ça fait un plafond de 13410 mais comme il travail 50 % , ça fait que 6705, donc 6705 en TA et le restant en T2)

euh ça va vous suivez ?!!!
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
Extraire des lignes
2 3
Réponses
41
Affichages
1 K
matthieu2701
M
Akortys
  • Question
Microsoft 365 RESOLU - Macro - Recherche de lignes identiques et ressortir les lignes uniques
Réponses
2
Affichages
285
Akortys
Akortys
A
  • Résolu(e)
Microsoft 365 Correction d'un code vba
2
Réponses
22
Affichages
874
AD95
A
J
  • Question
XL 2016 Tableau de bord - report de données
2
Réponses
16
Affichages
511
chris
chris
X
  • Question
XL pour MAC Colorier une cellule dans les lignes impaires de mon tableau, dont la valeur est > à 150
2
Réponses
15
Affichages
790
TooFatBoy
TooFatBoy
L
  • Question
Microsoft 365 trier lignes TCD
Réponses
10
Affichages
263
Cousinhub
Cousinhub
Icefedor
  • Résolu(e)
XL 2021 Case à cocher afin d'insérer des lignes dans une autre feuille
Réponses
2
Affichages
459
Icefedor
Icefedor
L
  • Question
XL 2013 Macro pour exporter sur excel certaines données d'un fichier txt
Réponses
1
Affichages
435
sylvanu
sylvanu
chris6999
  • Question
Microsoft 365 MACRO VBA - Extraire des listes à partir d'une boucle
Réponses
5
Affichages
254
chris6999
chris6999
O
  • Question
XL 2016 Archivage de lignes sous condition
Réponses
7
Affichages
265
Staple1600
Staple1600

Membres actuellement en ligne

10 membres et 103 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 488
Messages
2 088 835
Membres
103 972
dernier inscrit
steeter