Discussion :

[fisico016]

Bonjour a tous,

Voici mon petit problème:
Dans une feuille j'ai une base données comprenant plusieurs colonnes:
- Lignes
- Tronçon A
- Tronçon B
-Zone
- Feuille
Dans la seconde feuille utilisée pour la macro, je voudrais faire une recherche par ligne troncon A et troncon B. Je souhaiterais faire un genre de triage automatique c'est à dire apres avoir sélectionné une ligne, il me permettrait de seulement choisir les troncon de la ligne selectionnée et le même principe pour le troncon B.
Est-ce clair? Quelqu'un a t il une idée à me proposer.Je peux vous fournir mon fichier.
Merci d'avance.

Voici le code déjà encodé:

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
sub Macro2()
'
' Macro2 Macro
' Macro enregistrée le 18/04/2008 par AXC8300
'
'
Dim j As Double, k As Double
    Sheets("Feuil2").Select
    Range("A9").Select
    ligne = Range("A9").Value
    Cells(9, 2).Select
    A = Cells(9, 2).Value
    Cells(9, 3).Select
    B = Cells(9, 3).Value
    Range("A6").Select
    zone = Range("A6").Value
    Cells(6, 2).Select
    feuille = Cells(6, 2).Value
    Range("A13:T999").Select
    Selection.ClearContents
    Range("j6:T6").Select
    Selection.ClearContents
    Sheets("resume").Select
    Cells(1, 1).Select
    k = 13
    l = 2
    i = 1
    If zone <> "" Then
    While l > i
    Cells.Find(What:=zone, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    l = ActiveCell.Row
    Cells(l, 5).Select
    If feuille = Cells(l, 5).Value Then
    Rows(l).Select
    Selection.Copy
    Sheets("Feuil2").Select
    Cells(k, 1).Select
    ActiveSheet.Paste
    k = k + 1
    Sheets("resume").Select
    i = i + 1
    Cells(l + 1, 1).Select
    If l < i Then
    Sheets("Feuil2").Select
    Rows(k - 1).Select
    Rows(k - 1).Clear
    End If
    Else
    i = i + 1
    End If
   Wend
   Else
   While l > i
     Cells.Find(What:=ligne, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    l = ActiveCell.Row
    Cells(l, 2).Select
    If A = Cells(l, 2).Value Then
    If B = Cells(l, 3).Value Then
    Rows(l).Select
    Selection.Copy
    Sheets("Feuil2").Select
    Cells(k, 1).Select
    ActiveSheet.Paste
    k = k + 1
    Sheets("resume").Select
    i = i + 1
    Cells(l, 1).Select
     End If
    Else
    i = i + 1
    Cells(l, 1).Select
    End If
   Wend
   End If
   Sheets("Feuil2").Select
   For i = 0 To 10
   Cells(6, 10 + i).Select
   ActiveCell.FormulaR1C1 = "=MAX(R[7]C:R[9999]C)"
   Next
   End Sub

[Godzestla]

Ton code étant peu lisible,
je le reformatte pour essayer de comprendre quelquechose.

Pense à utiliser les balises code (Tu clique sur # et tu insères ton code entre les 2 balises).

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
 
ub Macro2()
'
' Macro2 Macro
' Macro enregistrée le 18/04/2008 par AXC8300
'
'
Dim j As Double, k As Double
Sheets("Feuil2").Select
Range("A9").Select
ligne = Range("A9").Value
Cells(9, 2).Select
A = Cells(9, 2).Value
Cells(9, 3).Select
B = Cells(9, 3).Value
Range("A6").Select
zone = Range("A6").Value
Cells(6, 2).Select
feuille = Cells(6, 2).Value
Range("A13:T999").Select
Selection.ClearContents
Range("j6:T6").Select
Selection.ClearContents
Sheets("resume").Select
Cells(1, 1).Select
k = 13
l = 2
i = 1
If zone <> "" Then
While l > i
Cells.Find(What:=zone, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
l = ActiveCell.Row
Cells(l, 5).Select
If feuille = Cells(l, 5).Value Then
Rows(l).Select
Selection.Copy
Sheets("Feuil2").Select
Cells(k, 1).Select
ActiveSheet.Paste
k = k + 1
Sheets("resume").Select
i = i + 1
Cells(l + 1, 1).Select
If l < i Then
Sheets("Feuil2").Select
Rows(k - 1).Select
Rows(k - 1).Clear
End If
Else
i = i + 1
End If
Wend
Else
While l > i
Cells.Find(What:=ligne, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
l = ActiveCell.Row
Cells(l, 2).Select
If A = Cells(l, 2).Value Then
If B = Cells(l, 3).Value Then
Rows(l).Select
Selection.Copy
Sheets("Feuil2").Select
Cells(k, 1).Select
ActiveSheet.Paste
k = k + 1
Sheets("resume").Select
i = i + 1
Cells(l, 1).Select
End If
Else
i = i + 1
Cells(l, 1).Select
End If
Wend
End If
Sheets("Feuil2").Select
For i = 0 To 10
Cells(6, 10 + i).Select
ActiveCell.FormulaR1C1 = "=MAX(R[7]C:R[9999]C)"
Next
End Sub 
 
 
Règles de messages