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

Résolu
Julie_12 -  
 Julie_12 -
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


2 réponses

  1.
    Frenchie83 Messages postés 2254 Statut Membre 339
     
    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
    1. Julie_12
       
      C'est parfait, merci beaucoup !!

      Bonne soirée
      0
  2. Frenchie83 Messages postés 2254 Statut Membre 339
     
    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
    1. Julie_12
       
      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 index of
khitty -
mikesophie -

26 réponses
problème d'ouverture dossier open office options filtre ASCII
capucine 33 -
bigbeany -

2 réponses
film .mkv
TAVERNIER -
Erwan031284 -

3 réponses