Problème indice de ligne avec fonction Large

**julio44** · 20/07/2011, 09h45

Bonjour à tous.

J'ai réalisé une macro qui à partir d'un fichier d'environ 4000 lignes, récupère en colonne A les X ( X = nbtests) plus "grandes" dates (fonction Large), grâce à une boucle for.

Dès lors, je récupère cette date, ainsi que le numéro de la ligne correspondante:
Ceci est stocké dans un tableau à 2 dimensions.

La première contient des dates, dates qui sont récupérées grâce à la fonction Large.

La deuxième contient le numéro de la ligne correspondant à cette date.

La macro tourne bien lorsque toutes les dates récupérées sont différentes, cependant si deux dates récupérées sont égales (ligne 32 et ligne 524 par exemple) et bien le numéro de ligne correspondant sera 2 fois 32.
Alors que je devrais récupérer 32 et 524.

J'exporte ensuite les lignes correspondantes, et ce dans un fichier texte.

Je n'arrive pas à modifier la macro, et je me tourne donc vers vous afin de m'aider.

Voici le code :

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
Sub Ma macro()
    Dim nbtests As Integer
    Dim tab_dates_compta_max()
    Dim I As Integer
    Dim fichiercible As Variant
 
    nbtests = Range("A1").End(xlDown).Row * (0.1 / 100)
 
    ReDim tab_dates_compta_max(nbtests, 1 To 2)
 
    Set Plage1 = Range([A1], [A65536].End(xlUp))
 
    For I = 1 To nbtests
 
      tab_dates_compta_max(I, 1) = CDate(Application.WorksheetFunction.Large(Plage1, I))
      tab_dates_compta_max(I, 2) = Plage1.Find(tab_dates_compta_max(I, 1), , xlValues, xlWhole).Row
 
    Next i
 
 
fichiercible = Application.GetSaveAsFilename("Sortie de ma macro", "Fichier texte (*.txt), (*.txt)")
 
    If fichiercible = False Then Exit Sub
 
        Open fichiercible For Output As #1
 
        If fichiercible <> False Then
 
    Print #1, "Contrôle N°1"
    Print #1,
    Print #1, "Test sur les dates comptabilité max"
            For I = 1 To nbtests
 
                    Print #1, Left(Range("A" & tab_dates_compta_max(I, 2)).Text, 10) & Space(10 - Len(Left(Range("A" & tab_dates_compta_max(I, 2)).Text, 10))) 
' je vous épargne les 27 autres lignes =)
next i
Close #1
    End If
End Sub

Merci pour votre aide !

Julien

**mercatog** · 20/07/2011, 11h11

Bonjour
J'avais déjà pensé à une autre variante (dans ton autre post) en utilisant un filtre automatique en prenant les 10 plus grandes valeurs.

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
Sub Macro1()
Dim Plage As Range, c As Range
Dim LastLig As Long
Dim i As Integer
Dim Tb()
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")                        'adapte le nom de ta feuille
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    If LastLig > 11 Then
        .Range("A1:A" & LastLig).AutoFilter Field:=1, Criteria1:="10", Operator:=xlTop10Items
        Set Plage = .Range("A2:A" & LastLig).SpecialCells(xlCellTypeVisible)
        ReDim Tb(1 To Plage.Count, 1 To 2)
        For Each c In Plage
            i = i + 1
            Tb(i, 1) = c.Value
            Tb(i, 2) = c.Row
        Next c
        Set Plage = Nothing
    End If
    .AutoFilterMode = False
End With
 
'On transfère notre tableau dans Feuil2 pour le test
Worksheets("Feuil2").Range("A1").Resize(UBound(Tb, 1), 2) = Tb
End Sub

Le petit bémol, le tableau n'est pas trié et peut donner plus que 10 valeurs (En effet, le filtre se transforme en "Filtrer après cette date)

**julio44** · 20/07/2011, 12h06

merci de ta réponse.

Je ne comprends pas exactement le bémol.

Sinon à tout hasard, est-il possible de remplacer ton "10" par mon nbtests ?

**mercatog** · 20/07/2011, 12h17

Sinon à tout hasard, est-il possible de remplacer ton "10" par mon nbtests ?

fais le test, n'aies pas peur de tester.

Pour mon bémol, essaies de faire une liste avec seulement 20 dates identiques.
Le résultat tu auras les 20 lignes (et non 10) logique non?

**julio44** · 20/07/2011, 13h59

je vais partir sur ton code, et à la fin n'imprimer que de 1 à nbtests, pas opti mais fonctionnel =)

Qu'en penses-tu ?

Edit : Enfin finalement, je ne comprends pas les dimensions du tableau. pour 4527 lignes j'obtiens :

lastlig = 4527
plage.count = 176

Peux-tu m'éclairer ?

**mercatog** · 20/07/2011, 14h21

lastlig = 4527
plage.count = 176

tes données avant filtrage, tu as 4527 lignes
Après filtrage, 176 ligne répondant au critère (les 10 plus grandes dates)

En utilisant la variable nbTests (ici=7)

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
Sub Macro1()
Dim Plage As Range, c As Range
Dim LastLig As Long
Dim i As Integer
Dim nbTests As Byte
Dim Tb()
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")                        'adapte le nom de ta feuille
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    nbTests = 7
    If LastLig > nbTests + 1 Then
        .Range("A1:A" & LastLig).AutoFilter Field:=1, Criteria1:=nbTests, Operator:=xlTop10Items
        Set Plage = .Range("A2:A" & LastLig).SpecialCells(xlCellTypeVisible)
        ReDim Tb(1 To Plage.Count, 1 To 2)
        For Each c In Plage
            i = i + 1
            Tb(i, 1) = c.Value
            Tb(i, 2) = c.Row
        Next c
        Set Plage = Nothing
    End If
    .AutoFilterMode = False
End With
 
'On transfère notre tableau dans Feuil2 pour le test
Worksheets("Feuil2").Range("A1").Resize(UBound(Tb, 1), 2) = Tb
End Sub

**julio44** · 20/07/2011, 14h44

Merci de l'éclairage !

Et donc une dernière question qui résoudrait tout :

Mon critère nbtests correspond au nombre de lignes que je dois retourner et non au nombre de dates.

Peut-on modifier le code dans cette voie ?

Je chercher de mon coté également.

Edit : ton dernier code ne marche pas de mon coté.

"la méthode autofilter de la classe range a échoué"

car 7 inférieur à 10 (xlTop10Items je pense)

**mercatog** · 20/07/2011, 14h57

1. Le dernier code fonctionne.
2. supposons que tu veux retourner les 7 dernières plus grandes dates (les 7 plus récentes) et dans ta base tu as 24 fois la dernière plus grande date. Quelles lignes tu veux récupérer?

par exemple
1/01/2011
3/01/2011
...
10/01/2011
10/01/2011
10/01/2011
10/01/2011
10/01/2011
10/01/2011
10/01/2011
10/01/2011
10/01/2011

Ici la plus grande date est 10/01/2011 (9 données) alors que tu veux en retours 7 lignes.

**julio44** · 20/07/2011, 15h05

1. Au temps pour moi.

2. Je souhaite seulement 7 id de lignes différentes =) peut importe lesquelles.

**mercatog** · 20/07/2011, 15h15

1. tu dois adapter à ton fichier
2. si tes données sont triés, dans Tb on se limite & nbTests éléments

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
Sub Macro1()
Dim Plage As Range, c As Range
Dim LastLig As Long
Dim i As Integer
Dim nbTests As Byte
Dim Tb()
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")                        'adapte le nom de ta feuille
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    nbTests = 4
    If LastLig > nbTests + 1 Then
        .Range("A1:A" & LastLig).AutoFilter Field:=1, Criteria1:=nbTests, Operator:=xlTop10Items
        Set Plage = .Range("A2:A" & LastLig).SpecialCells(xlCellTypeVisible)
        ReDim Tb(1 To nbTests, 1 To 2)
        For Each c In Plage
            i = i + 1
            Tb(i, 1) = c.Value
            Tb(i, 2) = c.Row
            If i >= nbTests Then Exit For
        Next c
        Set Plage = Nothing
    End If
    .AutoFilterMode = False
End With
 
'On transfère notre tableau dans Feuil2 pour le test
Worksheets("Feuil2").Range("A1").Resize(nbTests, 2) = Tb
End Sub

**julio44** · 20/07/2011, 15h31

Merci bcp.

Je vais essayer de trier grâce à vba, en effet :

je ne m'en sors pas étant donné que je dois réaliser ceci une vingtaine de fois avant de récupérer les lignes et les exporter en texte.

mais bon j'ai tous les outils.

merci encore mercatog.

**mercatog** · 20/07/2011, 16h57

Tu peux mettre un extrait de ton fichier (laisse seulement la colonne des dates)

**julio44** · 21/07/2011, 09h34

Voilà.

Merci

**mercatog** · 21/07/2011, 11h20

Le dernier code pour nbtests=20 donne ceci:
31/05/2012 17
31/05/2012 18
31/05/2012 51
31/05/2012 52
31/05/2012 66
31/05/2012 67
31/05/2012 75
31/05/2012 130
31/05/2012 147
31/05/2012 148
31/05/2012 149
31/05/2012 150
31/05/2012 151
31/05/2012 152
31/05/2012 153
31/05/2012 154
31/05/2012 160
31/05/2012 188
31/05/2012 235
31/05/2012 236

**julio44** · 22/07/2011, 14h49

Re !

J'ai revu totalement ma copie :

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
Sub Controle1()
 
Dim i As Integer
Dim nbTests As Byte
 
nbTests = Range("A1").End(xlDown).Row * (1 / 100)
 
Application.ScreenUpdating = False
 
Print #1,
Print #1, "Contrôle N°1"
Print #1,
 
' PREMIER TEST 
 
Print #1,
Print #1, "Test 1"
Print #1,
 
Columns("A:AD").Select
Selection.Sort Key1:=Range("Z2"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 
For i = 2 To nbTests + 1
 
        Print #1, Left(Range("A" & i).Text, 10) & Space(10 - Len(Left(Range("A" & i).Text, 10))) & Left(Range("B" & i).Text, 4) & Space(4 - Len(Left(Range("B" & i).Text, 4))) & Left(Range("C" & i).Text, 30) & Space(30 - Len(Left(Range("C" & i).Text, 30))) & _
        Left(Range("D" & i).Text, 9) & Space(9 - Len(Left(Range("D" & i).Text, 9))) & Left(Range("E" & i).Text, 13) & Space(13 - Len(Left(Range("E" & i).Text, 13))) & Left(Range("F" & i).Text, 14) & Space(14 - Len(Left(Range("F" & i).Text, 14))) & _
        Left(Range("G" & i).Text, 4) & Space(4 - Len(Left(Range("G" & i).Text, 4))) & Left(Range("H" & i).Text, 1) & Space(1 - Len(Left(Range("H" & i).Text, 1))) & Left(Range("I" & i).Text, 1) & Space(1 - Len(Left(Range("I" & i).Text, 1))) & _
        Left(Range("J" & i).Text, 1) & Space(1 - Len(Left(Range("J" & i).Text, 1))) & Left(Range("K" & i).Text, 1) & Space(1 - Len(Left(Range("K" & i).Text, 1))) & Left(Range("L" & i).Text, 4) & Space(4 - Len(Left(Range("L" & i).Text, 4))) & _
        Left(Range("M" & i).Text, 10) & Space(10 - Len(Left(Range("M" & i).Text, 10))) & Left(Range("N" & i).Text, 13) & Space(13 - Len(Left(Range("N" & i).Text, 13))) & Left(Range("O" & i).Text, 2) & Space(2 - Len(Left(Range("O" & i).Text, 2))) & _
        Left(Range("P" & i).Text, 30) & Space(30 - Len(Left(Range("P" & i).Text, 30))) & Left(Range("Q" & i).Text, 30) & Space(30 - Len(Left(Range("Q" & i).Text, 30))) & Left(Range("R" & i).Text, 5) & Space(5 - Len(Left(Range("R" & i).Text, 5))) & _
        Left(Range("S" & i).Text, 7) & Space(7 - Len(Left(Range("S" & i).Text, 7))) & Left(Range("T" & i).Text, 14) & Space(14 - Len(Left(Range("T" & i).Text, 14))) & Left(Range("U" & i).Text, 14) & Space(14 - Len(Left(Range("U" & i).Text, 14))) & _
        Left(Range("V" & i).Text, 7) & Space(7 - Len(Left(Range("V" & i).Text, 7))) & Left(Range("W" & i).Text, 14) & Space(14 - Len(Left(Range("W" & i).Text, 14))) & Left(Range("X" & i).Text, 1) & Space(1 - Len(Left(Range("X" & i).Text, 1))) & _
        Left(Range("Y" & i).Text, 14) & Space(14 - Len(Left(Range("Y" & i).Text, 14))) & Left(Range("Z" & i).Text, 14) & Space(14 - Len(Left(Range("Z" & i).Text, 14))) & Left(Range("AA" & i).Text, 1) & Space(1 - Len(Left(Range("AA" & i).Text, 1))) & _
        Left(Range("AB" & i).Text, 10) & Space(10 - Len(Left(Range("AB" & i).Text, 10))) & Left(Range("AC" & i).Text, 1) & Space(1 - Len(Left(Range("AC" & i).Text, 1))) & Left(Range("AD" & i).Text, 10) & Space(10 - Len(Left(Range("AD" & i).Text, 10)))
 
Next i
 
Application.ScreenUpdating = True
 
End Sub