Créer une variable égale au numéro de la boucle en cours

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

Je poste ici car je suis en train de créer une macro pour automatiser un traitement excel long et pénible.

J'ai un tableau ou chaque colonne est définit par une valeur de temps placée sur la ligne 1 et ou chaque ligne correspond à une fréquence placée en colonne A.
Je souhaite extraire les "temps" et "fréquence" correspondant à la valeur la plus proche de 0.2 pour chacune de mes colonnes (allant de B2:B232 à EK2:EK232 soit 131 colonnes, si je ne dis pas de conneries). Puis copier ces temps et fréquences dans un tableau présent sur une autre feuille (basiquement mon tableau de données en Feuil1 et mon tableau de resultats en Feuil2 avec les temps en A2:Ax et les fréquences en B2:Bx) Je ne sais pas si je suis très clair...

Voici la macro que j'ai commencé à rédiger:
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 Sub ferfghjk() Dim PORC As Double Dim macellulite As Range Dim tamere As Range Dim i As Integer Set F1 = Worksheets("Feuil1") Set F2 = Worksheets("Feuil2") For i = 1 To 131 F1.Select Set tamere = F1.Columns("i + 1").Row("1:232") PORC = Application.Match("0.2", [tamere], -1).Value Set macellulite = Columns("PORC").Rows("i + 1") macellulite.Select Selection.End(xlUp).Select Selection.Copy F2.Select Cells(i + 1, 1).Select ActiveSheet.Paste F1.Select macellulite.Select Selection.End(xlToLeft).Select Selection.Copy F2.Select Cells(i + 1, 2).Select ActiveSheet.Paste Next i End Sub
Mon soucis (peut être pas le seul) est de réussir à bien définir mes variables et notamment mon i que j'ai définit comme un PORC... Désolé ci mon code vous parait pérave et mon problème obsolète, mais je débute.

Je vous joins mon classeur.

Merci d'avance! Force et courage!

Bonjour,

pas trop le temps d'optimiser, mais regarde si déjà ça répond partiellement (voir totalement) à ta demande

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
Sub toto()
Dim Cell As Range
Dim Tabl(1 To 132, 1 To 3)
 
Application.ScreenUpdating = False
 
Tabl(1, 1) = "TEMPS"
Tabl(1, 2) = "FREQUENCE"
Tabl(1, 3) = "VALEUR"
Feuil2.Cells.Delete
 
With Feuil1
    ' boucle sur les colonnes
    For i = 2 To .UsedRange.Columns.Count - 1
        ' filtre automatique
        With .Cells(1, 1)
            .AutoFilter
            ' on filtre les valeurs inférieures ou égales à 0,2
            .AutoFilter i, "<=0.2"
        End With
        ' on cherche la cellule approchant de 0,2
        Set Cell = .Columns(i).SpecialCells(xlCellTypeVisible).Find(Application.WorksheetFunction.Subtotal(4, .Cells(2, i).Resize(UsedRange.Rows.Count - 1, 1)), , , xlWhole)
 
        ' si elle existe
        If Not Cell Is Nothing Then
            ' écriture du temps et fréquence
            Tabl(i, 1) = .Cells(1, i)
            Tabl(i, 2) = .Cells(Cell.Row, 1)
            Tabl(i, 3) = .Cells(Cell.Row, i)
        End If
    Next i
End With
 
' restitution du tableau de résultat
Feuil2.Cells(1, 1).Resize(UBound(Tabl, 1), 3).Value = Tabl
 
Application.ScreenUpdating = True
 
End Sub

14/08/2015, 15h40
Invité

erreur 424

Merci de ta réponse!

En lançant ta macro, j'ai malheureusement un "message d'erreur d'execution 424: objet recquis" qui s'affiche et jaunit la ligne:

Code:

Set Cell = .Columns(i).SpecialCells(xlCellTypeVisible).Find(Application.WorksheetFunction.Subtotal(4, .Cells(2, i).Resize(UsedRange.Rows.Count - 1, 1)), , , xlWhole)
14/08/2015, 17h02
joe.levrai

Bonjour,

est-ce que tu as testé sur ton classeur exemple ou sur un autre classeur ?

de mon côté j'ai aucun souci sur ton classeur exemple

il faut (si besoin) adapter le nom des feuilles sur ton autre classeur

mais confirme déjà si c'est ok sur ton fichier test
17/08/2015, 10h20
Invité

2 pièce(s) jointe(s)

Salut!

Que ce soit avec mon classeur exemple ou un nouveau identique, le même message d'erreur survient et la même ligne de code est mise en cause.

Pièce jointe 185580

Pièce jointe 185581

Je te joins les copies d'écran pour mieux me faire comprendre et possiblement te donner des pistes que je n'aurais pas su prendre en compte.

Merci encore du temps que tu consacres à mon problème!
17/08/2015, 11h22
joe.levrai

Bonjour,

et arf !!

je te prie de m'excuser, j'ai dû manger un "point" quand j'ai mis en forme le code avant de le coller dans mon message :aie:

voici, en rouge, le point qui manquait et que tu dois rajouter

Code:

Set Cell = .Columns(i).SpecialCells(xlCellTypeVisible).Find(Application.WorksheetFunction.Subtotal(4, .Cells(2, i).Resize(.UsedRange.Rows.Count - 1, 1)), , , xlWhole)
17/08/2015, 12h11
Invité

Résolu!!!!!!!!!

Ca marche impec'!

Merci infiniment!

Bonne journée
17/08/2015, 14h00
Docmarti

Bonjour.

Ne pas oublier de spécifier xlFormulas dans le paramètre LookIn car xlValues ne fonctionne pas pour trouver des valeurs avec autant de décimales.

Code:

Set Cell = .Columns(i).SpecialCells(xlCellTypeVisible).Find(Application.WorksheetFunction.Subtotal(4, .Cells(2, i).Resize(.UsedRange.Rows.Count - 1, 1)), , xlFormulas, xlWhole)