Sujet Précédent Sujet Suivant

Boucle à l'aide de valeurs d'ìndex de filtre

Résolu/Fermé
Julie_12 - 16 mars 2015 à 20:55
 Julie_12 - 17 mars 2015 à 20:20
Bonjour,


Je cherche à créer une macro pour pouvoir traiter un nombre important de données.
Mon tableau comporte trois colonnes (coordonnées en x, coordonnées en y et vitesse) pour un nombre variable de lignes suivant le fichier à traiter.

J'ai créé une Macro qui permet de filtrer les données du tableau suivant les valeurs de la première colonne. Ensuite la Macro sélectionne la première valeur du filtre, et copie les valeurs visibles de la colonne 'vitesse' dans une autre feuille en les transposant.

Ce que j'aimerai maintenant, c'est pouvoir créer une boucle pour que la Macro prenne successivement toutes les valeurs du filtre et copie pour chacune de ces valeurs de filtre les valeurs visibles de la colonne vitesse, pour obtenir au final une matrice (avec chaque ligne correspondant aux valeurs de la vitesse pour une valeur donnée de filtre. La première ligne correspondant à la plus petite valeur de filtre, et la dernière ligne correspondant à la plus grande valeur de filtre).

Merci d'avance,


PS : Voici la matrice qui traite les données mais sans la boucle si vous voulez avoir une meilleure idée de ce que je souhaite obtenir: 




Sub traiter_vitesse()

' Sort out values using a filter on x values

Sheets("Sheet1").Select
Range("A1:C10").Select
    Selection.AutoFilter

ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("A1:A10"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

' Filter x according to its first value and copying the corresponding velocity values

ActiveSheet.Range("$A$1:$C$10").AutoFilter Field:=1, Criteria1:="0"

Sheets("Sheet1").Select
Range("C2:C10").Select
    Selection.Copy
Sheets(3).Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

End Sub



A voir également:

2 réponses

Réponse 1 / 2
Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 337
17 mars 2015 à 20:11
Voilà 
Sub Traiter_Vitesse()
    Application.ScreenUpdating = False
    Sheets("Sheet1").Select
    Nbx = [A10000].End(xlUp).Row
    Range("A1:C1").Select
    ActiveSheet.AutoFilterMode = False
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("A1:A" & Nbx), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Columns("A:A").Select
    Selection.Copy
    Range("I1").Select
    Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("Z1"), Unique:=True
    NbVal = [Z10000].End(xlUp).Row
    ReDim Crit(NbVal) As String
    For i = 2 To NbVal
        Crit(i) = Cells(i, 26)
    Next i
    
    For i = 2 To NbVal
        ActiveSheet.Range("$A$1:$C" & Nbx).AutoFilter Field:=1, Criteria1:=Crit(i)
        Sheets("Sheet1").Select
        ActiveSheet.Range("C1:C" & Nbx).SpecialCells(xlCellTypeVisible).Copy
        Sheets("Sheet3").Select
        Range("A" & [A10000].End(xlUp).Row + 1).Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        If couleur = 8 Then couleur = 7 Else couleur = 8
        Selection.Interior.ColorIndex = couleur
        Sheets("Sheet1").Select
    Next i
    
    Sheets("Sheet1").Range("Z1:Z" & NbVal).Clear
    Sheets("Sheet3").Select
End Sub

Bonne soirée
1
Julie_12
17 mars 2015 à 20:20
C'est parfait, merci beaucoup !!

Bonne soirée
0
Réponse 2 / 2
Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 337
17 mars 2015 à 17:56
Bonjour
Si j'ai bien compris 
Sub Traiter_Vitesse()
    Application.ScreenUpdating = False
    Sheets("Sheet1").Select
    Nbx = [A10000].End(xlUp).Row
    Range("A1:C1").Select
    ActiveSheet.AutoFilterMode = False
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("A1:A" & Nbx), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Columns("A:A").Select
    Selection.Copy
    Range("I1").Select
    Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("Z1"), Unique:=True
    NbVal = [Z10000].End(xlUp).Row
    ReDim Crit(NbVal) As String
    For i = 2 To NbVal
        Crit(i) = Cells(i, 26)
    Next i
    
    For i = 2 To NbVal
        ActiveSheet.Range("$A$1:$C" & Nbx).AutoFilter Field:=1, Criteria1:=Crit(i)
        Sheets("Sheet1").Select
        Range("_FilterDataBase").Resize(, 3).SpecialCells(xlCellTypeVisible).Copy
        Sheets(3).Select
        Range("A" & [A10000].End(xlUp).Row + 1).Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        If couleur = 8 Then couleur = 7 Else couleur = 8
        Selection.Interior.ColorIndex = couleur
        Sheets("Sheet1").Select
    Next i
    
    Sheets("Sheet1").Range("Z1:Z" & NbVal).Clear
    Sheets(3).Select
End Sub

A essayer
cdlt
0
Julie_12
17 mars 2015 à 18:44
Bonjour,

Tout d`abord merci énormément pour votre travail ! C'est presque ce que je recherche, ça va beaucoup m'aider dans tous les cas. Y aurait-il moyen d'obtenir la même chose mais en ayant uniquement les lignes de la vitesse affichées ? C'est a dire exactement ce que vous avez fait, mais en supprimant les lignes de x et de y ? (Pour les valeurs de x et de y, je les affiche sur d'autres feuilles, mais ça j'arrive a m'en sortir).

Encore une fois, merci beaucoup,

Cordialement,
0

Discussions similaires

Mon pc s'allume et s'éteint en boucle
Jack -
Daniel -

16 réponses
télécharger sur des sites comme index of
khitty -
mikesophie -

26 réponses
programme qui n'affiche pas le mot secret
EMy.chev -
yg_be -

3 réponses
Index+Equiv avec 3 critères
CCB91 -
soignisec -

2 réponses
ou sont les bananes ?
Liline -
Le Pro -

2 réponses