copier des lignes selon deux conditions

[ghatfan99]

bonjour,
j'ai un fichier excel, et je veux copier des lignes selon deux conditions sur deux colonnes, pour cela j'ai essayé avec un macro mais j'arrive pas à bien faire les boucles,
mon table initial est de la forme:
id cof nom
904550690 5 BADOILPATRICK
902023220 2 BADOILPATRICK
904603149 4 BERNARDXAVIER
904946320 5 BERNARDXAVIER
904946314 5 BERNARDXAVIER
902022326 5 RAMONDPHILIPPE
904463576 5 RAMONDPHILIPPE

et je copier selon le nom et le cof: si j'ai le même nom je copie la ligne avec le cof le plus petit, si le cof et le nom sont egaux je copie tout, c'est a dire le résultat souhaité est:
id cof nom
902023220 2 BADOILPATRICK
904603149 4 BERNARDXAVIER
904946314 5 BERNARDXAVIER
902022326 5 RAMONDPHILIPPE
904463576 5 RAMONDPHILIPPE
et mon macro

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
 
Sub extrait()
  Dim Ligne     As Long
  Dim Rep     As String
  Dim Strat As String
  Dim NbLigne  As Long
  Dim NumLigne  As Long
  Dim testRep As String
  Dim testStrat As Long
 
  Sheets("feuil2").Activate ' feuille de destination
  Strat = "m" ' colonne non vide à tester
  Rep = "p"   ' colonne données non vides à tester'
  NumLigne = 2     'alors là ca doit etre le N° de la 1er ligne de données en comptant la ligne 1 = 0 .... ? '
  With Sheets("inittial")     ' feuille source'
  NbLigne = .Cells(65536, Rep).End(xlUp).Row
 
    'premiere valeur'
  testRep = .Cells(2, Rep).Value
  testStrat = .Cells(2, Strat).Value
  For Ligne = 2 To NbLigne
  MsgBox testStrat & "" & testRep
    If .Cells(Ligne, Rep).Value = testRep Then
        If .Cells(Ligne, Strat).Value >= testStrat Then
            testRep = .Cells(Ligne + 1, Rep).Value
            testStrat = .Cells(Ligne + 1, Strat).Value
            Ligne = Ligne + 1
            MsgBox "egal ou plus grand"
        Else
            testRep = .Cells(Ligne, Rep).Value
            testStrat = .Cells(Ligne, Strat).Value
            Ligne = Ligne + 1
            MsgBox "imprimer....."
            .Cells(Rep, Strat).EntireRow.copy
        End If
    Else
    testRep = .Cells(Ligne, Rep).Value
    testStrat = .Cells(Ligne, Strat).Value
    End If
  Next
 
  End With
End Sub

[mercatog]

Tes données sont triées par nom?

[geegee13]

Bonjour,

Code :

=DECALER('Calcul kit visserie'!$A$13:$f$76;1;;NB.SI('Calcul kit visserie'!$A$13:$A$76;Nommenclature!$B$7)-1)

en A36 (à copier sur le tableau)

Code :

=SI($B$4=VRAI;INDEX(Visserie;LIGNE($A36)-35;COLONNE(A1)+1);"")

J'ai imbriqué la fnction EQUIV dans la fonction DECALER.
En effet la fnction EQUIV me donne la le nombre de cellule entre mon origine et la cellule trouvée. Il ne reste plus qu'a intégrer le resultat dans l'option DECALER et le tur est joué.
j'ai joint mon fichier pur ce que cela pourrait intéresser.

NB : les cellule doivent impérativmeent être au format TEXTE pur fonctionner avec EQUIV ( en tout cas chez moi)

[ghatfan99]

rebonjour,
mergato: mes données nes sont pa triées
geegee13 merci pour ta reponse, je vais essayer ta solution, mais en VBA je peur comprndre mieux,
je ne connais pas les fonctions que t'as utilisé, je vais chercher leurs documentation
merci

bonjour,
j'ai essayé avec ce code mais j'ai l'erreur: erreur d'execution 1004, erreur definie par l'application ou par l'objet.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
 
Sub copyL(l As Long)
Sheets("feuil1").Activate ' feuille de destination
 
  With Sheets("inittial")     ' feuille source'
      .Cells(l, 1).EntireRow.copy
      Sheets("feuil1").Cells(NumLig, 1).Insert Shift:=xlDown
            'ici pour insérer ou  .Paste pour coller'
  End With
End Sub
 
Sub hazem()
  Dim L1     As Long
  Dim L2 As Long
  Dim LMin As Long
  Dim NbLigne As Long
  Sheets("feuil2").Activate ' feuille de destination
  Strat = "m"
  Rep = "p"   ' colonne données non vides à tester'
  With Sheets("inittial")     ' feuille source'
  NbLigne = .Cells(65536, Rep).End(xlUp).Row
  L1 = 2
  Do While L1 < NbLigne
  L2 = L1 + 1
  LMin = L1
  Do While (.Cells(L1, Rep).Value = .Cells(L2, Rep).Value)
 MsgBox "hiii"
   If (.Cells(L2, Start).Value <= .Cells(LMin, Start).Value) Then
    LMin = L2
    End If
   L2 = L2 + 1
  Loop
  copyL (LMin)
  L1 = L2
  Loop
  End With
End Sub

[mercatog]

Désolé, mais je n'ai pas bien compris Le résultat escompté eu regard de ton exemple donné en #1.
Si tu as un nom qui se répète plusieurs fois avec des coefficient tous différent, alors tu copie seulement la ligne avec le coefficient minimal.
Si tu as un nom avec qui se répète avec un unique coefficient, alors tu copie toutes les lignes.
Si tu as un nom qui se répète avec au moins un coefficient différent et avec au moins un coefficient unique, alors tu copie toutes les lignes
c'est ça?

Je pense que tu devrai expliquer davantage (avec un exemple parlant)

[ghatfan99]

bonjour,
oui mercatog, tu a bien compris, à partir de mon 1er exemple:
id cof nom
904550690 5 BADOILPATRICK
902023220 2 BADOILPATRICK
deux noms identiques avec des cof différents alors je garde la ligne avec le cof le plus petit: 902023220 2 BADOILPATRICK

904603149 4 BERNARDXAVIER
904946320 5 BERNARDXAVIER
904946314 5 BERNARDXAVIER
trois noms identiques avec des cof différents alors je garde la ligne avec le cof le plus petit: 904603149 4 BERNARDXAVIER

902022326 5 RAMONDPHILIPPE
904463576 5 RAMONDPHILIPPE
deux noms identiques avec des cof egaux alors je garde les deux lignes
902022326 5 RAMONDPHILIPPE
904463576 5 RAMONDPHILIPPE


j'espère que je suis bien claire (mon fichier contient 5000 lignes)

Merci davance