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 : Sélectionner tout - Visualiser dans une fenêtre à part
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